From 5ed6620bad808381fce94f2cd67ee911b4d45bff Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 21 Mar 2007 19:19:04 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.dcu | Bin 0 -> 8556 bytes Game/Code/Classes/TextGL.pas | 345 +++++++ Game/Code/Classes/UCatCovers.dcu | Bin 0 -> 4945 bytes Game/Code/Classes/UCatCovers.pas | 143 +++ Game/Code/Classes/UCovers.dcu | Bin 0 -> 6055 bytes Game/Code/Classes/UCovers.pas | 226 ++++ Game/Code/Classes/UDLLManager.dcu | Bin 0 -> 6021 bytes Game/Code/Classes/UDLLManager.pas | 216 ++++ Game/Code/Classes/UDraw.dcu | Bin 0 -> 41304 bytes Game/Code/Classes/UDraw.pas | 1613 +++++++++++++++++++++++++++++ Game/Code/Classes/UFiles.dcu | Bin 0 -> 4673 bytes Game/Code/Classes/UFiles.pas | 326 ++++++ Game/Code/Classes/UGraphic.dcu | Bin 0 -> 18647 bytes Game/Code/Classes/UGraphic.pas | 405 ++++++++ Game/Code/Classes/UGraphicClasses.dcu | Bin 0 -> 341 bytes Game/Code/Classes/UGraphicClasses.pas | 7 + Game/Code/Classes/UIni.dcu | Bin 0 -> 22355 bytes Game/Code/Classes/UIni.pas | 693 +++++++++++++ Game/Code/Classes/UJoystick.dcu | Bin 0 -> 2268 bytes Game/Code/Classes/UJoystick.pas | 124 +++ Game/Code/Classes/ULCD.dcu | Bin 0 -> 5497 bytes Game/Code/Classes/ULCD.pas | 287 +++++ Game/Code/Classes/ULCD.~pas | 287 +++++ Game/Code/Classes/ULanguage.dcu | Bin 0 -> 6519 bytes Game/Code/Classes/ULanguage.pas | 222 ++++ Game/Code/Classes/ULight.dcu | Bin 0 -> 2389 bytes Game/Code/Classes/ULight.pas | 116 +++ Game/Code/Classes/ULog.dcu | Bin 0 -> 6217 bytes Game/Code/Classes/ULog.pas | 227 ++++ Game/Code/Classes/ULyrics.dcu | Bin 0 -> 9029 bytes Game/Code/Classes/ULyrics.pas | 383 +++++++ Game/Code/Classes/UMain.dcu | Bin 0 -> 11501 bytes Game/Code/Classes/UMain.pas | 673 ++++++++++++ Game/Code/Classes/UMusic.dcu | Bin 0 -> 15179 bytes Game/Code/Classes/UMusic.pas | 783 ++++++++++++++ Game/Code/Classes/UParty.dcu | Bin 0 -> 4129 bytes Game/Code/Classes/UParty.pas | 204 ++++ Game/Code/Classes/UPliki.dcu | Bin 0 -> 19679 bytes Game/Code/Classes/UPliki.pas | 830 +++++++++++++++ Game/Code/Classes/URecord.dcu | Bin 0 -> 6913 bytes Game/Code/Classes/URecord.pas | 371 +++++++ Game/Code/Classes/UScores.dcu | Bin 0 -> 4811 bytes Game/Code/Classes/UScores.pas | 144 +++ Game/Code/Classes/USkins.dcu | Bin 0 -> 5747 bytes Game/Code/Classes/USkins.pas | 158 +++ Game/Code/Classes/USongs.dcu | Bin 0 -> 13980 bytes Game/Code/Classes/USongs.pas | 667 ++++++++++++ Game/Code/Classes/UTexture.dcu | Bin 0 -> 19192 bytes Game/Code/Classes/UTexture.pas | 811 +++++++++++++++ Game/Code/Classes/UThemes.dcu | Bin 0 -> 59165 bytes Game/Code/Classes/UThemes.pas | 1837 +++++++++++++++++++++++++++++++++ Game/Code/Classes/UTime.dcu | Bin 0 -> 2083 bytes Game/Code/Classes/UTime.pas | 81 ++ 53 files changed, 12179 insertions(+) create mode 100644 Game/Code/Classes/TextGL.dcu create mode 100644 Game/Code/Classes/TextGL.pas create mode 100644 Game/Code/Classes/UCatCovers.dcu create mode 100644 Game/Code/Classes/UCatCovers.pas create mode 100644 Game/Code/Classes/UCovers.dcu create mode 100644 Game/Code/Classes/UCovers.pas create mode 100644 Game/Code/Classes/UDLLManager.dcu create mode 100644 Game/Code/Classes/UDLLManager.pas create mode 100644 Game/Code/Classes/UDraw.dcu create mode 100644 Game/Code/Classes/UDraw.pas create mode 100644 Game/Code/Classes/UFiles.dcu create mode 100644 Game/Code/Classes/UFiles.pas create mode 100644 Game/Code/Classes/UGraphic.dcu create mode 100644 Game/Code/Classes/UGraphic.pas create mode 100644 Game/Code/Classes/UGraphicClasses.dcu create mode 100644 Game/Code/Classes/UGraphicClasses.pas create mode 100644 Game/Code/Classes/UIni.dcu create mode 100644 Game/Code/Classes/UIni.pas create mode 100644 Game/Code/Classes/UJoystick.dcu create mode 100644 Game/Code/Classes/UJoystick.pas create mode 100644 Game/Code/Classes/ULCD.dcu create mode 100644 Game/Code/Classes/ULCD.pas create mode 100644 Game/Code/Classes/ULCD.~pas create mode 100644 Game/Code/Classes/ULanguage.dcu create mode 100644 Game/Code/Classes/ULanguage.pas create mode 100644 Game/Code/Classes/ULight.dcu create mode 100644 Game/Code/Classes/ULight.pas create mode 100644 Game/Code/Classes/ULog.dcu create mode 100644 Game/Code/Classes/ULog.pas create mode 100644 Game/Code/Classes/ULyrics.dcu create mode 100644 Game/Code/Classes/ULyrics.pas create mode 100644 Game/Code/Classes/UMain.dcu create mode 100644 Game/Code/Classes/UMain.pas create mode 100644 Game/Code/Classes/UMusic.dcu create mode 100644 Game/Code/Classes/UMusic.pas create mode 100644 Game/Code/Classes/UParty.dcu create mode 100644 Game/Code/Classes/UParty.pas create mode 100644 Game/Code/Classes/UPliki.dcu create mode 100644 Game/Code/Classes/UPliki.pas create mode 100644 Game/Code/Classes/URecord.dcu create mode 100644 Game/Code/Classes/URecord.pas create mode 100644 Game/Code/Classes/UScores.dcu create mode 100644 Game/Code/Classes/UScores.pas create mode 100644 Game/Code/Classes/USkins.dcu create mode 100644 Game/Code/Classes/USkins.pas create mode 100644 Game/Code/Classes/USongs.dcu create mode 100644 Game/Code/Classes/USongs.pas create mode 100644 Game/Code/Classes/UTexture.dcu create mode 100644 Game/Code/Classes/UTexture.pas create mode 100644 Game/Code/Classes/UThemes.dcu create mode 100644 Game/Code/Classes/UThemes.pas create mode 100644 Game/Code/Classes/UTime.dcu create mode 100644 Game/Code/Classes/UTime.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.dcu b/Game/Code/Classes/TextGL.dcu new file mode 100644 index 00000000..772d09c1 Binary files /dev/null and b/Game/Code/Classes/TextGL.dcu differ diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas new file mode 100644 index 00000000..cf09e48b --- /dev/null +++ b/Game/Code/Classes/TextGL.pas @@ -0,0 +1,345 @@ +unit TextGL; + +interface + +uses OpenGL12, SDL, UTexture, Classes, 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); + +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; + 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; + +implementation + +uses UMain, Windows, SysUtils, UGraphic; + +procedure BuildFont; // Build Our Bitmap Font +var + font: HFONT; // Windows Font ID + h_dc: hdc; + Rejestr: TResourceStream; + Pet: integer; +begin + ActFont := 0; + + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'BMP', 'Font', 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Done := -1; + Fonts[0].Outline := 0; + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'BMP', 'Font', 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Done := -1; + Fonts[1].Outline := 0; + + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'BMP', 'Font Outline', 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Done := -1; + Fonts[2].Outline := 5; + + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'BMP', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + Rejestr := TResourceStream.Create(HInstance, 'Font', 'FNT'); + Rejestr.Read(Fonts[0].Width, 256); + Rejestr.Free; + + Rejestr := TResourceStream.Create(HInstance, 'FontB', 'FNT'); + Rejestr.Read(Fonts[1].Width, 256); + Rejestr.Free; + + Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[2].Width, 256); + Rejestr.Free; + + Rejestr := TResourceStream.Create(HInstance, 'FontO2', 'FNT'); + Rejestr.Read(Fonts[3].Width, 256); + Rejestr.Free; + +{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[4].Width, 256); + Rejestr.Free;} + + for Pet := 0 to 255 do + Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; + + for Pet := 0 to 255 do + Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; + + for Pet := 0 to 255 do + Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; + +{ for Pet := 0 to 255 do + Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + while (length(text) > 0) do begin + Letter := Text[0]; + text := pchar(Copy(text, 2, Length(text)-1)); + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; // while +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; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; +// H := 30; + + // 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; + + // 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); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + glEnd; + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +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; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +var + Letter: char; +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 +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; + +end. diff --git a/Game/Code/Classes/UCatCovers.dcu b/Game/Code/Classes/UCatCovers.dcu new file mode 100644 index 00000000..2ff7a7d9 Binary files /dev/null and b/Game/Code/Classes/UCatCovers.dcu differ diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas new file mode 100644 index 00000000..00a758c8 --- /dev/null +++ b/Game/Code/Classes/UCatCovers.pas @@ -0,0 +1,143 @@ +unit UCatCovers; +///////////////////////////////////////////////////////////////////////// +// UCatCovers by Whiteshark // +// Class for listing and managing the Category Covers // +///////////////////////////////////////////////////////////////////////// + +interface +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, UPliki, ULog; + +constructor TCatCovers.Create; +begin + 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/UCovers.dcu b/Game/Code/Classes/UCovers.dcu new file mode 100644 index 00000000..ca99fc7c Binary files /dev/null and b/Game/Code/Classes/UCovers.dcu differ diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas new file mode 100644 index 00000000..55329fd2 --- /dev/null +++ b/Game/Code/Classes/UCovers.pas @@ -0,0 +1,226 @@ +unit UCovers; + +interface +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, UThemes, UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation +uses UPliki, ULog, DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test +// W := 128; +// H := 128; +// Bits := 24; +// Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + +// SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); +// BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + if FileExists(GamePath + 'covers.cache') then begin + Reset(F, 1); + Seek(F, FileSize(F)); + end else + Rewrite(F, 1); + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + while (C <= High(Cover)) and (Result = false) do begin + if Cover[C].Name = Name then Result := true; + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + while (C <= High(Cover)) and (Result = -1) do begin + if Cover[C].Name = Name then Result := C; + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UDLLManager.dcu b/Game/Code/Classes/UDLLManager.dcu new file mode 100644 index 00000000..3ba97949 Binary files /dev/null and b/Game/Code/Classes/UDLLManager.dcu differ diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas new file mode 100644 index 00000000..151f0617 --- /dev/null +++ b/Game/Code/Classes/UDLLManager.pas @@ -0,0 +1,216 @@ +unit UDLLManager; + +interface +uses ModiSDK, UPliki; + +type + TDLLMan = class + private + hLib: THandle; + P_Init: fModi_Init; + P_Draw: fModi_Draw; + P_Finish: fModi_Finish; + P_RData: pModi_RData; + public + Plugins: array of TPluginInfo; + PluginPaths: array of String; + Selected: ^TPluginInfo; + + constructor Create; + + procedure GetPluginList; + procedure ClearPluginInfo(No: Cardinal); + function LoadPluginInfo(Filename: String; No: Cardinal): boolean; + + function LoadPlugin(No: Cardinal): boolean; + procedure UnLoadPlugin; + + function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: fModi_PlaySound): boolean; + function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; + function PluginFinish (var Playerinfo: TPlayerinfo): byte; + procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); + end; + +var + DLLMan: TDLLMan; + +const DLLPath = 'Plugins\'; + +implementation +uses Windows, ULog, SysUtils; + + +constructor TDLLMan.Create; +begin + SetLength(Plugins, 0); + SetLength(PluginPaths, Length(Plugins)); + GetPluginList; +end; + +procedure TDLLMan.GetPluginList; +var + SR: TSearchRec; +begin + + if FindFirst(DLLPath + '*.dll', faAnyFile , SR) = 0 then + begin + repeat + SetLength(Plugins, Length(Plugins)+1); + SetLength(PluginPaths, Length(Plugins)); + + if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful + begin + PluginPaths[High(PluginPaths)] := SR.Name; + end + else //Error Loading + begin + SetLength(Plugins, Length(Plugins)-1); + SetLength(PluginPaths, Length(Plugins)); + end; + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +procedure TDLLMan.ClearPluginInfo(No: Cardinal); +begin + Plugins[No].Name := 'unknown'; + Plugins[No].NumPlayers := 0; + + Plugins[No].Creator := 'Nobody'; + Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; + + Plugins[No].LoadSong := True; + Plugins[No].ShowScore := True; + Plugins[No].ShowBars := False; + Plugins[No].ShowNotes := True; + Plugins[No].LoadVideo := True; + Plugins[No].LoadBack := True; + + Plugins[No].TeamModeOnly := False; + Plugins[No].GetSoundData := False; + Plugins[No].Dummy := False; + + + Plugins[No].BGShowFull := False; + Plugins[No].BGShowFull_O := True; + + Plugins[No].ShowRateBar:= False; + Plugins[No].ShowRateBar_O := True; + + Plugins[No].EnLineBonus := False; + Plugins[No].EnLineBonus_O := True; +end; + +function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; +var + hLibg: THandle; + Info: pModi_PluginInfo; + I: Integer; +begin + Result := False; + //Clear Plugin Info + ClearPluginInfo(No); + + {//Workaround Plugins Loaded 2 Times + For I := low(PluginPaths) to high(PluginPaths) do + if (PluginPaths[I] = Filename) then + exit; } + + //Load Libary + hLibg := LoadLibrary(PChar(DLLPath + Filename)); + //If Loaded + if (hLibg <> 0) then + begin + //Load Info Procedure + @Info := GetProcAddress (hLibg, PChar('PluginInfo')); + + //If Loaded + if (@Info <> nil) then + begin + //Load PluginInfo + Info (Plugins[No]); + Result := True; + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); + + FreeLibrary (hLibg); + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); +end; + +function TDLLMan.LoadPlugin(No: Cardinal): boolean; +begin + Result := False; + //Load Libary + hLib := LoadLibrary(PChar(DLLPath + PluginPaths[No])); + //If Loaded + if (hLib <> 0) then + begin + //Load Info Procedure + @P_Init := GetProcAddress (hLib, PChar('Init')); + @P_Draw := GetProcAddress (hLib, PChar('Draw')); + @P_Finish := GetProcAddress (hLib, PChar('Finish')); + + //If Loaded + if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then + begin + Selected := @Plugins[No]; + Result := True; + end + else + begin + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); + + end; + end + else + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); +end; + +procedure TDLLMan.UnLoadPlugin; +begin +if (hLib <> 0) then + FreeLibrary (hLib); + +//Selected := nil; +@P_Init := nil; +@P_Draw := nil; +@P_Finish := nil; +@P_RData := nil; +end; + +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: fModi_PlaySound): boolean; +begin +if (@P_Init <> nil) then + Result := P_Init (TeamInfo, PlayerInfo, Sentences, LoadTex, Print, LoadSound, PlaySound) +else + Result := False +end; + +function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; +begin +if (@P_Draw <> nil) then + Result := P_Draw (PlayerInfo, CurSentence) +else + Result := False +end; + +function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; +begin +if (@P_Finish <> nil) then + Result := P_Finish (PlayerInfo) +else + Result := 0; +end; + +procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); +begin +if (@P_RData <> nil) then + P_RData (handle, buffer, len, user); +end; + +end. diff --git a/Game/Code/Classes/UDraw.dcu b/Game/Code/Classes/UDraw.dcu new file mode 100644 index 00000000..a3fcecc9 Binary files /dev/null and b/Game/Code/Classes/UDraw.dcu differ diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas new file mode 100644 index 00000000..e9433790 --- /dev/null +++ b/Game/Code/Classes/UDraw.pas @@ -0,0 +1,1613 @@ +unit UDraw; + +interface +uses UThemes, ModiSDK; + +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; NrCzesci: integer); +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +procedure SingDrawStar(X, Y, A: real); +procedure SingGoldenStar(X, Y, A: real); + +// The Singbar +procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); + +//Phrasen Bonus - Line Bonus +procedure SingDrawLineBonus( const X, Y: integer; Color: TRGB; Alpha: Single; Text: string); + +//Draw Editor NoteLines +procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 Mod + TickOld: cardinal; + TickOld2:cardinal; + //end Singbar Mod + + + + +const + Przedz = 32; + +implementation + +uses Windows, OpenGL12, 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 >= 1 then begin + + glClearColor (1, 1, 1, 1); + + if (Ini.MovieSize = 0) 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 + Pet: integer; +begin; +// Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); + + glBegin(GL_LINE_STRIP); + glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + for Pet := 2 to Sound[NrSound].n div 1 do begin + glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), + -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + end; + glEnd; +end; + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Pet: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Pet := 0 to 9 do begin + glVertex2f(Left, Top + Pet * Space); + glVertex2f(Right, Top + Pet * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +var + Pet: integer; + TempR: real; +begin + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin + if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + + // Golden Note Patch + case Wartosc of + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + + glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(31/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_Right[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 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 + //case Wartosc of + // 2: SingGoldenStar(Rec.Left, Rec.Top, 1, StarfrG); + //end; // case + + + end; // if not FreeStyle + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + + +// draw sung notes +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R: real; + G: real; + B: real; + 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].IlNut > 0 then begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do begin + with Player[NrGracza].Nuta[N] do begin + // lewa czesc + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + + + // Half size Notes Patch + if Hit then begin + NotesH2 := NotesH + end else begin + NotesH2 := int(NotesH * 0.65); + end; //if + + + + // if True then + Rec.Top := Y - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc + Rec.Left := Rec.Right; + Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + // (nowe) + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.MidBeatD)) * TempR; + + if Rec.Right <= Rec.Left then Rec.Right := Rec.Left; + + +// glColor3f(R, G, B); +// glBindTexture(GL_TEXTURE_2D, Tex_MidGray.TexNum); + glBindTexture(GL_TEXTURE_2D, Tex_Mid[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glColor3f(1, 1, 1); + + // prawa czesc + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_Right[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + + + //Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + //if (Start+Dlugosc-1 = Czas.AktBeatD) then + if Perfect AND (Ini.GMAFix <> 1) then begin +// A := sqrt((1+sin(Music.Position * 3))/2); + A := 1 - 2*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + + + SingDrawStar(Rec.Left+2, Rec.Top+4, A); + end; + + // detekt +{ Rec.Left := Round((Detekt-Czesci.Czesc[Czesci.Akt].Start) * TempR) + 130; + glColor3f(1, 0.2, 0.2); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + glBegin(GL_QUADS); + glVertex(Rec.Left, Rec.Top-5); + glVertex(Rec.Left, Rec.Bottom+5); + glVertex(Rec.Left+1, Rec.Bottom+5); + glVertex(Rec.Left+1, Rec.Top-5); + glEnd; + glColor3f(1, 1, 1); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D);} + + // detekt + FFT length +{ Rec.Right := (Detekt-Czesci.Czesc[Czesci.Akt].Start) * TempR + 130; + // TempR = dlugosc 1 kostki + // 60 * 4 / BPM = czas w sekundach na 1 kostke, np. 0,4s + // 4096 / 44100 = czas jednego sampla FFT, np. 0,1s + // ile to ma kostek? np. 0.25 + // (4096 / 44100) / (60 * 4 / BPM), np. 0,1s / 0,4s = 0.25 + // * TempR = dlugosc sampla FFT + Rec.Left := Rec.Right - (Sound.n / 44100) / (60 * 4 / Muzyka.BPM) * TempR; + + glColor3f(1, 0.2, 0.2); + glVertex(Rec.Left, Rec.Top-4); + glVertex(Rec.Left, Rec.Bottom+4); + glVertex(Rec.Right, Rec.Bottom+4); + glVertex(Rec.Right, Rec.Top-4);} + + end; // with + end; // for + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; +begin + if (Player[NrGracza].ScoreTotalI >= 0) then begin + glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + + // srodkowa czesc + Rec.Left := X2; + Rec.Right := X3; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(31/32, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc + Rec.Left := X3; + Rec.Right := X4; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[NrGracza+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 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 SingDrawStar(X, Y, A: real); +var + TempR: real; + W, H: real; + Starframe: real; + begin + W := 32; + H := 32; + + // Golden Star Patch +// case Z of +// 1: glColor4f(1, 1, 1, A); +// 2: glColor4f(1, 1, 0.3, A); +// end; // case + + glColor4f(1, 1, 1, A); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); + + Starframe := 15 - ((GetTickCount div 33) mod 16); + + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Starframe, 0); glVertex2f(X-W, Y-H); + glTexCoord2f((1/16) * Starframe + (1/16), 0); glVertex2f(X-W, Y+H); + glTexCoord2f((1/16) * Starframe + (1/16), 1); glVertex2f(X+W, Y+H); + glTexCoord2f((1/16) * Starframe, 1); glVertex2f(X+W, Y-H); + glEnd; +end; + + +procedure SingGoldenStar(X, Y, A: real); +var + TempR: real; + W, H: real; + StarfrG2: real; + begin + W := 16; + H := 16; + glColor4f(1, 1, 0.3, A); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); + StarfrG2 := 15 - ((GetTickCount div 67) mod 16); + glBegin(GL_QUADS); + //x1 + glTexCoord2f((1/16) * StarfrG2, 0); glVertex2f(X-W, Y-H); + glTexCoord2f((1/16) * StarfrG2 + (1/16), 0); glVertex2f(X-W, Y+H); + glTexCoord2f((1/16) * StarfrG2 + (1/16), 1); glVertex2f(X+W, Y+H); + glTexCoord2f((1/16) * StarfrG2, 1); glVertex2f(X+W, Y-H); + glEnd; +end; + + +procedure SingDraw; +var + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + + + +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; + + // time bar +// Log.LogStatus('Time Bar', 'SingDraw'); + glBegin(GL_QUADS); + glColor3f(0.9, 0.9, 0.9); + glVertex2f(140 + 10*ScreenX, 21); + glVertex2f(140 + 10*ScreenX, 29); + glVertex2f(330 + 10*ScreenX, 29); + glVertex2f(330 + 10*ScreenX, 21); + glColor3f(Skin_TimeR, Skin_TimeG, Skin_TimeB); + glVertex2f(140 + 10*ScreenX, 21); + glVertex2f(140 + 10*ScreenX, 29); + glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 29); + glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 21); + glEnd; + + // rysuje paski pod nutami + 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; + + // rysuje tekst - new Lyric engine + ScreenSing.LyricMain.Draw; + ScreenSing.LyricSub.Draw; + + // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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_BLEND); + glBegin(GL_QUADS); + glColor4f(26/255, 165/255, 220/255, 0); + glVertex2f(Rec.Left, Rec.Top); + glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(26/255, 165/255, 220/255, BarAlpha); + glVertex2f(Rec.Right, Rec.Bottom); + 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 + + //SingBar Mod + else if Ini.Oscilloscope = 2 then begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + if PlayersPlay = 1 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + end; + if PlayersPlay = 2 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + end; + if PlayersPlay = 3 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + end; + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + end; + end; + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if Ini.LineBonus > 0 then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + + if Player[E].LineBonus_Alpha <= 0 then + Player[E].LineBonus_Visible := False + else + begin + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then + Inc(Player[E].LineBonus_PosX,1) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then + Dec(Player[E].LineBonus_PosX,1); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Inc(Player[E].LineBonus_PosY,1) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Dec(Player[E].LineBonus_PosY,1); + + end; + end; + end; //if + + if PlayersPlay = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + end + else if PlayersPlay = 2 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + end + else if PlayersPlay = 3 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + end + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + end; + end; + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text); + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text); + end; + end; + end; + //PhrasenBonus - Line Bonus Mod End + + + // rysuje paski +// Log.LogStatus('Original notes', 'SingDraw'); + 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 PlayersPlay = 1 then begin + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(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; + + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + end; + end; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +procedure SingModiDraw (PlayerInfo: TPlayerInfo); +var + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + + + +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; + + // time bar +// Log.LogStatus('Time Bar', 'SingDraw'); + glBegin(GL_QUADS); + glColor3f(0.9, 0.9, 0.9); + glVertex2f(140 + 10*ScreenX, 21); + glVertex2f(140 + 10*ScreenX, 29); + glVertex2f(330 + 10*ScreenX, 29); + glVertex2f(330 + 10*ScreenX, 21); + glColor3f(Skin_TimeR, Skin_TimeG, Skin_TimeB); + glVertex2f(140 + 10*ScreenX, 21); + glVertex2f(140 + 10*ScreenX, 29); + glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 29); + glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 21); + glEnd; + + if DLLMan.Selected.ShowNotes then + begin + // rysuje paski pod nutami + 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; + + // rysuje tekst - new Lyric engine + ScreenSingModi.LyricMain.Draw; + ScreenSingModi.LyricSub.Draw; + + // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * + // (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].LyricWidth / 2 * FS - 50); + (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; + + // 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_BLEND); + glBegin(GL_QUADS); + glColor4f(26/255, 165/255, 220/255, 0); + glVertex2f(Rec.Left, Rec.Top); + glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(26/255, 165/255, 220/255, BarAlpha); + glVertex2f(Rec.Right, Rec.Bottom); + glVertex2f(Rec.Right, Rec.Top); + glEnd; + glDisable(GL_BLEND); + end; + + // oscilloscope + 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 + + //SingBar Mod + else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + end; + if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + end; + if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + end; + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + end; + end; + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + + if Player[E].LineBonus_Alpha <= 0 then + Player[E].LineBonus_Visible := False + else + begin + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then + Inc(Player[E].LineBonus_PosX,1) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then + Dec(Player[E].LineBonus_PosX,1); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Inc(Player[E].LineBonus_PosY,1) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Dec(Player[E].LineBonus_PosY,1); + + end; + end; + end; //if + + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + end + else if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + end + else if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + end + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + end; + end; + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text); + end; + end; + end; + //PhrasenBonus - Line Bonus Mod End + + + // rysuje paski +// Log.LogStatus('Original notes', 'SingDraw'); + 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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(1/16, 0); glVertex2f(X, Y); + glTexCoord2f(1/16, 1); glVertex2f(X, Y+H); + glTexCoord2f(1 - 1/16, 1); glVertex2f(X+W, Y+H); + glTexCoord2f(1 - 1/16, 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(1/16, 0); glVertex2f(X, Y); + glTexCoord2f(1/16, 1); glVertex2f(X, Y+H); + glTexCoord2f(1 - 1/16, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); + glTexCoord2f(1 - 1/16, 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 Mod +procedure SingDrawLineBonus( const X, Y: integer; Color: TRGB; Alpha: Single; Text: string); +var +Length, X2: Real; //Length of Text +begin +if Alpha <> 0 then +begin + +//Set Font Propertys +SetFontStyle(2); //Font: Outlined1 +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 + + //Draw Background + glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //Old Method with Variable Background + {//Draw Left Side + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusL.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y + Tex_SingLineBonusL.H * Tex_SingLineBonusL.ScaleH); + glTexCoord2f(1, 1); glVertex2f(X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW, Y + Tex_SingLineBonusL.H * Tex_SingLineBonusL.scaleH); + glTexCoord2f(1, 0); glVertex2f(X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW, Y); + glEnd; + + //Set X of Next Tile + X2 := X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW; + + //Draw Middle + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusM.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X2, Y); + glTexCoord2f(0, 1); glVertex2f(X2, Y + Tex_SingLineBonusM.H * Tex_SingLineBonusM.ScaleH); + glTexCoord2f(1, 1); glVertex2f(X2 + Length, Y + Tex_SingLineBonusM.H * Tex_SingLineBonusM.scaleH); + glTexCoord2f(1, 0); glVertex2f(X2 + Length, Y); + glEnd; + + //Set X of Next Tile + X2 := X2 + Length; + + //Draw Rigth Side + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusR.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X2, Y); + glTexCoord2f(0, 1); glVertex2f(X2, Y + Tex_SingLineBonusR.H * Tex_SingLineBonusR.ScaleH); + glTexCoord2f(1, 1); glVertex2f(X2 + Tex_SingLineBonusR.W * Tex_SingLineBonusR.scaleW, Y + Tex_SingLineBonusR.H * Tex_SingLineBonusR.scaleH); + glTexCoord2f(1, 0); glVertex2f(X2 + Tex_SingLineBonusR.W * Tex_SingLineBonusR.scaleW, Y); + glEnd;} + //New Method, Not Variable + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(1/32, 0); glVertex2f(X, Y); + glTexCoord2f(1/32, 1); glVertex2f(X, Y + 50); + glTexCoord2f(31/32, 1); glVertex2f(X + 100, Y + 50); + glTexCoord2f(31/32, 0); glVertex2f(X + 100, Y); + 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: +// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + + // Golden Note Patch + case Wartosc of + 0: glColor4f(1, 1, 1, 0.35); + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + + glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(31/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_Right[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/8, 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; + +end. + diff --git a/Game/Code/Classes/UFiles.dcu b/Game/Code/Classes/UFiles.dcu new file mode 100644 index 00000000..9ed45d8f Binary files /dev/null and b/Game/Code/Classes/UFiles.dcu differ diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas new file mode 100644 index 00000000..61fdab03 --- /dev/null +++ b/Game/Code/Classes/UFiles.pas @@ -0,0 +1,326 @@ +unit UFiles; + +interface + +uses USongs, SysUtils, ULog, UMusic; + +//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs +function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header +function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header +procedure ClearSong(var Song: TSong); //Clears Song Header values + +//procedure CzyscNuty; +//function WczytajCzesci(Name: string): boolean; +//function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +//function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; + +var + {//Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; //} + + SongFile: TextFile; // all procedures in this unit operates on this file + FileLineNo: integer; //Line which is readed at Last, for error reporting + + {// variables available for all procedures + Base: array[0..1] of integer; + Rel: array[0..1] of integer;//} + Mult: integer = 1; + MultBPM: integer = 4; + +implementation +uses TextGL, UIni, UMain, UPliki; + + //Function sets All Absolute Paths eg. for Songs +{procedure InitializePaths; +begin + GamePath := ExtractFilePath(ParamStr(0)); + SoundPath := GamePath + 'Sounds\'; + SongPath := GamePath + 'Songs\'; + LogPath := GamePath; + ThemePath := GamePath + 'Themes\'; + ScreenshotsPath := GamePath + 'Screenshots\'; + CoversPath := GamePath + 'Covers\'; + LanguagesPath := GamePath + 'Languages\'; + + DecimalSeparator := ','; +end;} + + //Clears Song Header values +procedure ClearSong(var Song: TSong); +begin + //Main Information + Song.Title := ''; + Song.Artist := ''; + + //Sortings: + Song.Genre := 'Unknown'; + Song.Edition := 'Unknown'; + Song.Language := 'Unknown'; //Language Patch + + //Required Information + Song.Mp3 := ''; + Song.BPM := 0; + Song.GAP := 0; + Song.Start := 0; + Song.Finish := 0; + + //Additional Information + Song.Background := ''; + Song.Video := ''; + Song.VideoGAP := 0; + Song.NotesGAP := 0; + Song.Resolution := 4; + Song.Creator := ''; +end; + + //Reads Standard TXT Header +function ReadTXTHeader(var Song: TSong): boolean; +var +Line, Identifier, Value: String; +Temp: word; +Done: byte; +begin + Result := true; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + Song.FileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # + While (Line[1] = '#') do + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + //Title + if (Identifier = 'TITLE') then + begin + Song.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + Song.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND (FileExists(Song.Path + Value)) then + begin + Song.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + SetLength(Song.BPM, 1); + Song.BPM[0].StartBeat := 0; + + Song.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; + + if Song.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + //Cover Picture + else if (Identifier = 'COVER') then + begin + Song.Cover := Value; + end + + //Background Picture + else if (Identifier = 'BACKGROUND') then + begin + Song.Background := Value; + end + + // Video File + else if (Identifier = 'VIDEO') then + begin + Song.Video := Value; + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.VideoGAP := StrtoFloatDef (Value, 0); + end + + //Genre Sorting + else if (Identifier = 'GENRE') then + begin + Song.Genre := Value; + end + + //Edition Sorting + else if (Identifier = 'EDITION') then + begin + Song.Edition := Value; + end + + //Creator Tag + else if (Identifier = 'CREATOR') then + begin + Song.Creator := Value; + end + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + begin + Song.Language := Value; + end + + // Song Start + else if (Identifier = 'START') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.Start := StrtoFloatDef(Value, 0); + end + + // Song Ending + else if (Identifier = 'END') then + begin + TryStrtoInt(Value, Song.Finish); + end + + // Resolution + else if (Identifier = 'RESOLUTION') then + begin + TryStrtoInt(Value, Song.Resolution); + end + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + begin + TryStrtoInt(Value, Song.NotesGAP); + end + + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + begin + Song.Relative := True; + end; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT: ' + Song.FileName); + break; + end; + + //End on first empty Line + if (Length(Line) = 0) then + break; + end; + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BMP Flag + Log.LogError('BMP Tag Missing: ' + Song.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + Song.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + Song.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + Song.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT: ' + Song.FileName); + end; + +end; + + //Analyse Song File and Read Header +function AnalyseFile(var Song: TSong): boolean; +begin +Result := False; +{try } + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, Song.Path + Song.FileName); + Reset(SongFile); + + //Clear old Song Header + ClearSong(Song); + + //Read Header + Result := ReadTxTHeader(Song); + + //And Close File + CloseFile(SongFile); +{except + CloseFile(SongFile); + + Result := False; + //Error Reporting + Log.LogError('An Error occured reading Line ' + inttostr(FileLineNo) + ' from SongHeader: ' + Song.FileName); +end;} +end; + + + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UGraphic.dcu b/Game/Code/Classes/UGraphic.dcu new file mode 100644 index 00000000..c264b16b Binary files /dev/null and b/Game/Code/Classes/UGraphic.dcu differ diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas new file mode 100644 index 00000000..05a9fda7 --- /dev/null +++ b/Game/Code/Classes/UGraphic.pas @@ -0,0 +1,405 @@ +unit UGraphic; + +interface +uses + SDL, OpenGL12, UTexture, TextGL, ULog, SysUtils, ULyrics, UScreenLoading, + UScreenWelcome, UScreenMain, UScreenName, UScreenLevel, UScreenOptions, UScreenOptionsGame, + UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, + UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, + UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, + {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + + Tex_Left: array[0..6] of TTexture; + Tex_Mid: array[0..6] of TTexture; + Tex_Right: array[0..6] of TTexture; + + Tex_BG_Left: array[1..6] of TTexture; + Tex_BG_Mid: array[1..6] of TTexture; + Tex_BG_Right: array[1..6] of TTexture; + + Tex_Note_Star: TTexture; + + Tex_Ball: TTexture; + FullScreen: boolean; + + + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: TTexture; + //End PhrasenBonus - Line Bonus Mod + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 500; // 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadScreens; + + +implementation +uses UMain, UIni, UDisplay; + +procedure LoadTextures; +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); + + // P1-6 + for P := 1 to 6 do begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Note Transparent', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Note Plain', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Note Transparent', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'BMP', 'Alpha Black Colored', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'BMP', 'Alpha Black Colored', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'BMP', 'Alpha Black Colored', Col); + end; + + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')), 'JPG', 'Font Black', 0); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + + + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'JPG', 'Font Black', 0); + {//Set Texture to Font High + Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; + Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; + Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } + //PhrasenBonus - Line Bonus Mod End + + // tworzenie czcionek + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure Initialize3D (Title: string); +begin + Log.LogStatus('LoadOpenGL', 'Initialize3D'); + Log.BenchmarkStart(2); + + LoadOpenGL; + +// SDL_WM_SetIcon(SDL_LoadBMP('..\Graphics\us.ico'),0); + + Log.LogStatus('SDL_Init', 'Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin + Log.LogError('SDL_Init Failed', 'Initialize3D'); + exit; + end; + + SDL_WM_SetCaption(PChar(Title), 'WM_DEFAULT'); + + InitializeScreen; + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur + Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + + LoadTextures; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Textures', 2); + + Log.BenchmarkStart(2); + Lyric := TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); + + Log.BenchmarkStart(2); + Display := TDisplay.Create; + SDL_EnableUnicode(1); + Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + + Log.LogStatus('Loading Screens', 'Initialize3D'); + Log.BenchmarkStart(3); + + LoadScreens; + Display.ActualScreen^.FadeTo(@ScreenMain); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, 800, 600, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; +begin + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + S := IResolution[Ini.Resolution]; + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; + + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + if (Ini.FullScreen = 0) and (ParamStr(1) <> '-fsblack') then + screen := SDL_SetVideoMode(W, H, (Ini.Depth+1) * 16, SDL_OPENGL) + else begin + screen := SDL_SetVideoMode(W, H, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end; + if (screen = nil) then begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadScreens; +begin + ScreenLoading := TScreenLoading.Create(''); + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; + + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + //ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); +end; + +end. diff --git a/Game/Code/Classes/UGraphicClasses.dcu b/Game/Code/Classes/UGraphicClasses.dcu new file mode 100644 index 00000000..58d003b0 Binary files /dev/null and b/Game/Code/Classes/UGraphicClasses.dcu differ diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas new file mode 100644 index 00000000..abb59e4b --- /dev/null +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -0,0 +1,7 @@ +unit UGraphicClasses; + +interface + +implementation + +end. diff --git a/Game/Code/Classes/UIni.dcu b/Game/Code/Classes/UIni.dcu new file mode 100644 index 00000000..e891d36c Binary files /dev/null and b/Game/Code/Classes/UIni.dcu differ diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas new file mode 100644 index 00000000..beadabb6 --- /dev/null +++ b/Game/Code/Classes/UIni.pas @@ -0,0 +1,693 @@ +unit UIni; + +interface +uses IniFiles, ULog, SysUtils; + +type + TIni = class + Name: array[0..5] of string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + //LineBonus Mod + LineBonus: integer; + //GMA Fix + GMAFix: integer; + + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + Threshold: integer; + //TwoPlayerMode: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + + // Record + Card: integer; // not saved in config.ini + + CardList: array of record + Name: string; + Input: integer; + ChannelL: integer; + ChannelR: integer; + end; + + // Controller + Joypad: integer; + + // Soundcards + SoundCard: array[0..7, 1..2] of integer; + + // Devices + LPT: integer; + + procedure Load; + procedure Save; + procedure SaveNames; + procedure SaveLevel; + end; + + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + ICard: array of string; + IInput: array of string; + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); + //IOscilloscope: array[0..1] of string = ('Off', 'On'); + + //Line Bonus MOd + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + //GMA Fix + IGMAFix: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..1] of string = ('Half', 'Full'); + + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + //ITwoPlayerMode: array[0..2] of string = ('Stereo', '2 Cards', 'Advanced'); + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); + + IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); + +implementation +uses UPliki, SDL, ULanguage, USkins, URecord; + +procedure TIni.Load; +var + IniFile: TMemIniFile; + ThemeIni: TMemIniFile; + Tekst: string; + Pet: integer; + B: boolean; + I, I2, I3: integer; + S: string; + Modes: PPSDL_Rect; + SR: TSearchRec; //Skin List Patch + +function GetFileName (S: String):String; + begin + //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); + Result := copy (S,0,Pos ('.ini',S)-1); + end; + +begin + GamePath := ExtractFilePath(ParamStr(0)); + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + // Name + for I := 0 to 5 do + Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + // Players + Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); + for Pet := 0 to High(IPlayers) do + if Tekst = IPlayers[Pet] then Ini.Players := Pet; + + // Difficulty + Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); + for Pet := 0 to High(IDifficulty) do + if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; + + // Language + Tekst := IniFile.ReadString('Game', 'Language', 'English'); + for Pet := 0 to High(ILanguage) do + if Tekst = ILanguage[Pet] then Ini.Language := Pet; + +// Language.ChangeLanguage(ILanguage[Ini.Language]); + + // Tabs + Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); + for Pet := 0 to High(ITabs) do + if Tekst = ITabs[Pet] then Ini.Tabs := Pet; + + //Tabs at Startup fix + Ini.Tabs_at_startup := Ini.Tabs; + + // Sorting + Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); + for Pet := 0 to High(ISorting) do + if Tekst = ISorting[Pet] then Ini.Sorting := Pet; + + // Debug + Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); + for Pet := 0 to High(IDebug) do + if Tekst = IDebug[Pet] then Ini.Debug := Pet; + + //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; + + // Screens + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + for Pet := 0 to High(IScreens) do + if Tekst = IScreens[Pet] then Ini.Screens := Pet; + + // Resolution + SetLength(IResolution, 0); + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + repeat +// Log.LogError(Format( ' %d x %d', [ modes^.w, modes^.h ] ) ); + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + until Modes^ = nil; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do begin + S := IResolution[I]; + IResolution[I] := IResolution[High(IResolution)-I]; + IResolution[High(IResolution)-I] := S; + end; + + Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + for Pet := 0 to High(IResolution) do + if Tekst = IResolution[Pet] then Ini.Resolution := Pet; + + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + // Resolution + Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); + for Pet := 0 to High(IDepth) do + if Tekst = IDepth[Pet] then Ini.Depth := Pet; + + // Texture Size + Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); + for Pet := 0 to High(ITextureSize) do + if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; + + // SingWindow + Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); + for Pet := 0 to High(ISingWindow) do + if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; + + // Oscilloscope + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Off'); + for Pet := 0 to High(IOscilloscope) do + if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; + + // Line Bonus + Tekst := IniFile.ReadString('Graphics', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + + //GMA Fix + Tekst := IniFile.ReadString('Graphics', 'GMAFix', 'Off'); + for Pet := 0 to High(IGMAFix) do + if Tekst = IGMAFix[Pet] then Ini.GMAFix := Pet; + + // Spectrum + Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); + for Pet := 0 to High(ISpectrum) do + if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; + + // Spectrograph + Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); + for Pet := 0 to High(ISpectrograph) do + if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; + + // MovieSize + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[0]); + for Pet := 0 to High(IMovieSize) do + if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; + + // MicBoost + Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); + for Pet := 0 to High(IMicBoost) do + if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; + + // ClickAssist + Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); + for Pet := 0 to High(IClickAssist) do + if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; + + // BeatClick + Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); + for Pet := 0 to High(IBeatClick) do + if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; + + // SavePlayback + Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); + for Pet := 0 to High(ISavePlayback) do + if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; + + // Threshold + Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); + for Pet := 0 to High(IThreshold) do + if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + + {// Two Player Mode + for I := 0 to 7 do begin + Ini.SoundCard[I, 1] := 2*I + 1; + Ini.SoundCard[I, 2] := 2*I + 2; + end; + + Tekst := IniFile.ReadString('Sound', 'TwoPlayerMode', ITwoPlayerMode[0]); + for Pet := 0 to High(ITwoPlayerMode) do + if Tekst = ITwoPlayerMode[Pet] then Ini.TwoPlayerMode := Pet; + + if Ini.TwoPlayerMode = 1 then begin + Ini.SoundCard[0, 1] := 1; + Ini.SoundCard[0, 2] := 3; + Ini.SoundCard[1, 1] := 2; + end;} + + // Lyrics Font + Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); + for Pet := 0 to High(ILyricsFont) do + if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; + + // Lyrics Effect + Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); + for Pet := 0 to High(ILyricsEffect) do + if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; + + // Solmization + Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); + for Pet := 0 to High(ISolmization) do + if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; + + // Theme + {SetLength(ITheme, 0); + if FileExists('Themes\Singstar.ini') then begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := 'Singstar'; + end; { + if FileExists('Themes\Karin.ini') then begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := 'Karin'; + end;} + + //Theme List Patch + SetLength(ITheme, 0); + FindFirst('Themes\*.ini',faAnyFile,SR); + Repeat + ThemeIni := TMemIniFile.Create(SR.Name); + Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); + ThemeIni.Free; + for Pet := low(Skin.Skin) to high(Skin.Skin) do + begin + if UpperCase(Skin.Skin[Pet].Theme) = Tekst then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := GetFileName(SR.Name); + break; + end; + end; + Until FindNext(SR) <> 0; + FindClose(SR); + //Theme List Patch End } + + //No Theme Found + if (Length(ITheme)=0) then + begin + Log.LogError('Could not find any valid Themes.'); + Halt; + end; + + + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[0]); + Ini.Theme := 0; + for Pet := 0 to High(ITheme) do + if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; + + // Skin + Skin.onThemeChange; + Ini.SkinNo := 0; + + Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); + for Pet := 0 to High(ISkin) do + if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; + + // Color + Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); + for Pet := 0 to High(IColor) do + if Tekst = IColor[Pet] then Ini.Color := Pet; + + // Record - load ini list + SetLength(CardList, 0); + I := 1; + while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin + //Automatically Delete not Existing Sound Cards + S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); + //{ + B := False; + //Look for Soundcard + for I2 := 0 to High(Recording.SoundCard) do + begin + if (S = Trim(Recording.SoundCard[I2].Description)) then + begin + B := True; + Break; + end; + end; + + if B then + begin //} + I3 := Length(CardList); + SetLength(CardList, I3+1); + Ini.CardList[I3].Name := S; + Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); + Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); + Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); + end; + Inc(I); + end; + + Log.LogError(InttoStr(Length(CardList)) + ' Cards Loaded'); + + // Record - append detected soundcards + for I := 0 to High(Recording.SoundCard) do + begin + B := False; + For I2 := 0 to High(CardList) do + begin //Search for Card in List + if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then + begin + B := True; + Break; + end; + end; + + //If not in List -> Add + If not B then + begin + I3 := Length(CardList); + SetLength(CardList, I3+1); + CardList[I3].Name := Trim(Recording.SoundCard[I].Description); + CardList[I3].Input := 0; + CardList[I3].ChannelL := 0; + CardList[I3].ChannelR := 0; + // default for new users + if (Length(CardList) = 1) then + CardList[I].ChannelL := 1; + end; + end; + + {for I := 0 to High(Recording.SoundCard) do begin + + B := false; + I2 := 0; + while ((B = false) and (I2 <= High(CardList))) do + if CardList[I2].Name = Recording.SoundCard[I].Description then B := true + else Inc(I2); + + // if the card wasn't detected in ini file, append it to the ini list + if B = false then begin + I3 := Length(CardList); + SetLength(CardList, I3+1); + CardList[I3].Name := Recording.SoundCard[I].Description; + CardList[I3].Input := 0; + CardList[I3].ChannelL := 0; + CardList[I3].ChannelR := 0; + if Length(CardList) = 1 then CardList[I].ChannelL := 1; // default for new users + //CardList[I].Input := 2; + end; + end; } + + Log.LogError(InttoStr(Length(CardList)) + ' Cards Detected'); + + // Joypad + Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); + for Pet := 0 to High(IJoypad) do + if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; + + // SoundCard + for I := 0 to 7 do begin + Ini.SoundCard[I, 1] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'L', Ini.SoundCard[I, 1]); + Ini.SoundCard[I, 2] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'R', Ini.SoundCard[I, 2]); + end; + + // LCD + Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); + for Pet := 0 to High(ILPT) do + if Tekst = ILPT[Pet] then Ini.LPT := Pet; + + + // SongPath + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + + + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; + Tekst: string; + I: Integer; + S: String; +begin + if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + IniFile := TIniFile.Create(GamePath + 'config.ini'); + + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); + + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); + + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); + + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); + + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); + + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); + + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); + + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); + + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); + + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); + + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); + + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); + + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Graphics', 'LineBonus', Tekst); + + //GMA Fix + Tekst := IGMAFix[Ini.GMAFix]; + IniFile.WriteString('Graphics', 'GMAFix', Tekst); + + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); + + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); + + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); + + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); + + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); + + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); + + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); + + {// Two Player Mode + Tekst := ITwoPlayerMode[Ini.TwoPlayerMode]; + IniFile.WriteString('Sound', 'TwoPlayerMode', Tekst); } + + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); + + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); + + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); + + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); + + // Record + for I := 0 to High(CardList) do begin + S := IntToStr(I+1); + + Tekst := CardList[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + + Tekst := IntToStr(CardList[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelL); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelR); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; + + Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); + + IniFile.Free; + end; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + if not FileIsReadOnly(GamePath + 'config.ini') then begin + IniFile := TIniFile.Create(GamePath + 'config.ini'); + + //Name + for I := 1 to 6 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; + I: integer; +begin + if not FileIsReadOnly(GamePath + 'config.ini') then begin + IniFile := TIniFile.Create(GamePath + 'config.ini'); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); + + IniFile.Free; + end; +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UJoystick.dcu b/Game/Code/Classes/UJoystick.dcu new file mode 100644 index 00000000..62cde484 Binary files /dev/null and b/Game/Code/Classes/UJoystick.dcu differ diff --git a/Game/Code/Classes/UJoystick.pas b/Game/Code/Classes/UJoystick.pas new file mode 100644 index 00000000..a2a06307 --- /dev/null +++ b/Game/Code/Classes/UJoystick.pas @@ -0,0 +1,124 @@ +unit UJoystick; + +interface + +uses SDL; + +type + TJoyButton = record + State: integer; + Enabled: boolean; + Type_: byte; + Sym: cardinal; + end; + + TJoyUnit = record + Button: array[0..15] of TJoyButton; + end; + + TJoy = class + constructor Create; + procedure Update; + end; + +var + Joy: TJoy; + JoyUnit: TJoyUnit; + SDL_Joy: PSDL_Joystick; + JoyEvent: TSDL_Event; + +implementation + +uses SysUtils; + +constructor TJoy.Create; +var + B, N: integer; +begin + //Old Corvus5 Method + {// joystick support + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks <> 1 then beep; + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then beep; + + if SDL_JoystickNumButtons(SDL_Joy) <> 16 then beep; + +// 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 beep; + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then beep; + + N := SDL_JoystickNumButtons(SDL_Joy); + if N < 6 then beep; + + 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_UP; + JoyUnit.Button[1].Sym := SDLK_RIGHT; + JoyUnit.Button[2].Sym := SDLK_DOWN; + JoyUnit.Button[3].Sym := SDLK_LEFT; + + JoyUnit.Button[4].Sym := SDLK_RETURN; + JoyUnit.Button[5].Sym := SDLK_ESCAPE; +end; + +procedure TJoy.Update; +var + B: integer; +begin + SDL_JoystickUpdate; + + 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; + +end; + +end. diff --git a/Game/Code/Classes/ULCD.dcu b/Game/Code/Classes/ULCD.dcu new file mode 100644 index 00000000..8098a187 Binary files /dev/null and b/Game/Code/Classes/ULCD.dcu differ diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas new file mode 100644 index 00000000..a127c689 --- /dev/null +++ b/Game/Code/Classes/ULCD.pas @@ -0,0 +1,287 @@ +unit ULCD; + +interface + +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, zlportio, UTime; + +procedure TLCD.WriteCommand(B: Byte); +// Wysylanie komend sterujacych +begin + 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); + + TimeSleep(0.1); + + 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 + TimeSleep(0.1); +end; + +procedure TLCD.WriteData(B: Byte); +// Wysylanie danych +begin + 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); + + TimeSleep(0.1); + + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $07); + end; + + TimeSleep(0.1); + Inc(Position); +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 +// +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/ULCD.~pas b/Game/Code/Classes/ULCD.~pas new file mode 100644 index 00000000..a127c689 --- /dev/null +++ b/Game/Code/Classes/ULCD.~pas @@ -0,0 +1,287 @@ +unit ULCD; + +interface + +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, zlportio, UTime; + +procedure TLCD.WriteCommand(B: Byte); +// Wysylanie komend sterujacych +begin + 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); + + TimeSleep(0.1); + + 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 + TimeSleep(0.1); +end; + +procedure TLCD.WriteData(B: Byte); +// Wysylanie danych +begin + 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); + + TimeSleep(0.1); + + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $07); + end; + + TimeSleep(0.1); + Inc(Position); +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 +// +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/ULanguage.dcu b/Game/Code/Classes/ULanguage.dcu new file mode 100644 index 00000000..2d5c3596 Binary files /dev/null and b/Game/Code/Classes/ULanguage.dcu differ diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas new file mode 100644 index 00000000..bc3793e3 --- /dev/null +++ b/Game/Code/Classes/ULanguage.pas @@ -0,0 +1,222 @@ +unit ULanguage; + +interface + +type + TLanguageEntry = record + ID: string; + Text: string; + end; + + TLanguageList = record + Name: string; + {FileName: string; } + end; + + TLanguage = class + private + Entry: array of TLanguageEntry; //Entrys of Chosen Language + SEntry: array of TLanguageEntry; //Entrys of Standard Language + CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version + Implode_Glue1, Implode_Glue2: String; + public + List: array of TLanguageList; + + constructor Create; + procedure LoadList; + function Translate(Text: String): String; + procedure ChangeLanguage(Language: String); + procedure AddConst(ID, Text: String); + procedure ChangeConst(ID, Text: String); + function Implode(Pieces: Array of String): String; + end; + +var + Language: TLanguage; + +implementation + +uses UPliki, UIni, IniFiles, Classes, SysUtils, Windows, ULog; + +//---------- +//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues +//---------- +constructor TLanguage.Create; +var + I, J: Integer; +begin + LoadList; + + //Set Implode Glues for Backward Compatibility + Implode_Glue1 := ', '; + Implode_Glue2 := ' and '; + + if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading + Log.CriticalError('Could not load any Language Files'); + + //Standard Language (If a Language File is Incomplete) + //Then use English Language + for I := 0 to high(List) do //Search for English Language + begin + //English Language Found -> Load + if Uppercase(List[I].Name) = 'ENGLISH' then + begin + ChangeLanguage('English'); + + SetLength(SEntry, Length(Entry)); + for J := low(Entry) to high(Entry) do + SEntry[J] := Entry[J]; + + SetLength(Entry, 0); + end; + + if (I = high(List)) then + Log.LogError('English Languagefile missing! No standard Translation loaded'); + end; + //Standard Language END + +end; + +//---------- +//LoadList - Parse the Language Dir searching Translations +//---------- +procedure TLanguage.LoadList; +var + SR: TSearchRec; // for parsing directory +begin + SetLength(List, 0); + SetLength(ILanguage, 0); + + if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin + repeat + SetLength(List, Length(List)+1); + SetLength(ILanguage, Length(ILanguage)+1); + SR.Name := ChangeFileExt(SR.Name, ''); + + List[High(List)].Name := SR.Name; + ILanguage[High(ILanguage)] := SR.Name; + + until FindNext(SR) <> 0; + SysUtils.FindClose(SR); + end; // if FindFirst +end; + +//---------- +//ChangeLanguage - Load the specified LanguageFile +//---------- +procedure TLanguage.ChangeLanguage(Language: String); +var + IniFile: TIniFile; + E: integer; // entry + S: TStringList; +begin + SetLength(Entry, 0); + IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); + S := TStringList.Create; + + IniFile.ReadSectionValues('Text', S); + SetLength(Entry, S.Count); + for E := 0 to high(Entry) do + begin + if S.Names[E] = 'IMPLODE_GLUE1' then + Implode_Glue1 := S.ValueFromIndex[E]+ ' ' + else if S.Names[E] = 'IMPLODE_GLUE2' then + Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; + + Entry[E].ID := S.Names[E]; + Entry[E].Text := S.ValueFromIndex[E]; + end; + + S.Free; + IniFile.Free; +end; + +//---------- +//Translate - Translate the Text +//---------- +Function TLanguage.Translate(Text: String): String; +var + E: integer; // entry +begin + Result := Text; + + //Const Mod + for E := 0 to high(CEntry) do + if Text = CEntry[E].ID then + begin + Result := CEntry[E].Text; + exit; + end; + //Const Mod End + + for E := 0 to high(Entry) do + if Text = Entry[E].ID then + begin + Result := Entry[E].Text; + exit; + end; + + //Standard Language (If a Language File is Incomplete) + //Then use Standard Language + if Text = Result then + begin + for E := low(SEntry) to high(SEntry) do + if Text = SEntry[E].ID then + begin + Result := SEntry[E].Text; + exit; + end; + end; + //Standard Language END +end; + +//---------- +//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile +//---------- +procedure TLanguage.AddConst (ID, Text: String); +begin + SetLength (CEntry, Length(CEntry) + 1); + CEntry[high(CEntry)].ID := ID; + CEntry[high(CEntry)].Text := Text; +end; + +//---------- +//ChangeConst - Change a Constant Value by ID +//---------- +procedure TLanguage.ChangeConst(ID, Text: String); +var + I: Integer; +begin + for I := 0 to high(CEntry) do + begin + if CEntry[I].ID = ID then + begin + CEntry[I].Text := Text; + Break; + end; + end; +end; + +//---------- +//Implode - Connect an Array of Strings with ' and ' or ', ' to one String +//---------- +function TLanguage.Implode(Pieces: Array of String): String; +var + I: Integer; +begin + Result := ''; + //Go through Pieces + for I := low(Pieces) to high(Pieces) do + begin + //Add Value + Result := Result + Pieces[I]; + + //Add Glue + if (I < high(Pieces) - 1) then + Result := Result + Implode_Glue1 + else if (I < high(Pieces)) then + Result := Result + Implode_Glue2; + end; +end; + +end. diff --git a/Game/Code/Classes/ULight.dcu b/Game/Code/Classes/ULight.dcu new file mode 100644 index 00000000..10ba61bc Binary files /dev/null and b/Game/Code/Classes/ULight.dcu differ diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas new file mode 100644 index 00000000..967d2ea1 --- /dev/null +++ b/Game/Code/Classes/ULight.pas @@ -0,0 +1,116 @@ +unit ULight; +interface + +type + TLight = class + private + Enabled: boolean; + Light: array[0..7] of boolean; + LightTime: array[0..7] of real; // time to stop, need to call update to change state + LastTime: real; + public + constructor Create; + procedure Enable; + procedure SetState(State: integer); + procedure AutoSetState; + procedure TurnOn; + procedure TurnOff; + procedure LightOne(Number: integer; Time: real); + procedure Refresh; + end; + +var + Light: TLight; + +const + Data = $378; // default port address + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, zlportio, UTime; + +constructor TLight.Create; +begin + Enabled := false; +end; + +procedure TLight.Enable; +begin + Enabled := true; + LastTime := GetTime; +end; + +procedure TLight.SetState(State: integer); +begin + if Enabled then + PortWriteB($378, State); +end; + +procedure TLight.AutoSetState; +var + State: integer; +begin + if Enabled then begin + State := 0; + if Light[0] then State := State + 2; + if Light[1] then State := State + 1; + // etc + SetState(State); + end; +end; + +procedure TLight.TurnOn; +begin + if Enabled then + SetState(3); +end; + +procedure TLight.TurnOff; +begin + if Enabled then + SetState(0); +end; + +procedure TLight.LightOne(Number: integer; Time: real); +begin + if Enabled then begin + if Light[Number] = false then begin + Light[Number] := true; + AutoSetState; + end; + + LightTime[Number] := GetTime + Time/1000; // [s] + end; +end; + +procedure TLight.Refresh; +var + Time: real; + TimeSkip: real; + L: integer; +begin + if Enabled then begin + Time := GetTime; + TimeSkip := Time - LastTime; + for L := 0 to 7 do begin + if Light[L] = true then begin + if LightTime[L] > Time then begin + // jest jeszcze zapas - bez zmian + //LightTime[L] := LightTime[L] - TimeSkip; + end else begin + // czas minal + Light[L] := false; + end; + end; + end; + LastTime := Time; + AutoSetState; + end; +end; + +end. + + diff --git a/Game/Code/Classes/ULog.dcu b/Game/Code/Classes/ULog.dcu new file mode 100644 index 00000000..1794325d Binary files /dev/null and b/Game/Code/Classes/ULog.dcu differ diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas new file mode 100644 index 00000000..6bffa04e --- /dev/null +++ b/Game/Code/Classes/ULog.pas @@ -0,0 +1,227 @@ +unit ULog; + +interface + +uses Classes; + +type + TLog = class + BenchmarkTimeStart: array[0..7] of real; + BenchmarkTimeLength: array[0..7] of real;//TDateTime; + + FileBenchmark: TextFile; + FileBenchmarkO: boolean; // opened + FileAnalyze: TextFile; + FileAnalyzeO: boolean; // opened + FileError: TextFile; + FileErrorO: boolean; // opened + + Title: String; //Application Title + + // destuctor + destructor Free; + + // benchmark + procedure BenchmarkStart(Number: integer); + procedure BenchmarkEnd(Number: integer); + procedure LogBenchmark(Text: string; Number: integer); + + // analyze + procedure LogAnalyze(Text: string); + + // error + procedure LogError(Text: string); overload; + + //Critical Error (Halt + MessageBox) + procedure CriticalError(Text: string); + + // voice + procedure LogVoice(SoundNr: integer); + + // compability + procedure LogStatus(Log1, Log2: string); + procedure LogError(Log1, Log2: string); overload; + end; + +var + Log: TLog; + +implementation +uses UPliki, SysUtils, DateUtils, URecord, UTime, UIni, Windows; + +destructor TLog.Free; +begin + if FileBenchmarkO then CloseFile(FileBenchmark); +// if FileAnalyzeO then CloseFile(FileAnalyze); + if FileErrorO then CloseFile(FileError); +end; + +procedure TLog.BenchmarkStart(Number: integer); +begin + BenchmarkTimeStart[Number] := USTime.GetTime; //Time; +end; + +procedure TLog.BenchmarkEnd(Number: integer); +begin + BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; +end; + +procedure TLog.LogBenchmark(Text: string; Number: integer); +var + Minutes: integer; + Seconds: integer; + Miliseconds: integer; + + MinutesS: string; + SecondsS: string; + MilisecondsS: string; + + ValueText: string; +begin + if (ParamStr(1) = '-benchmark') then begin + if not FileBenchmarkO then begin + FileBenchmarkO := true; + AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); + {$I-} + Rewrite(FileBenchmark); + if IOResult = 0 then FileBenchmarkO := true; + {$I+} + end; + + if FileBenchmarkO then begin + Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); + Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; + Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); +// ValueText := FloatToStr(BenchmarkTimeLength[Number]); + +{ ValueText := FloatToStr( + SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 + ); + if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then + ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; + WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} + + if (Minutes = 0) and (Seconds = 0) then begin + MilisecondsS := IntToStr(Miliseconds); + ValueText := MilisecondsS + ' miliseconds'; + end; + + if (Minutes = 0) and (Seconds >= 1) then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + + ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; + end; + + if Minutes >= 1 then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; + + MinutesS := IntToStr(Minutes); + + ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; + end; + + WriteLn(FileBenchmark, Text + ': ' + ValueText); + Flush(FileBenchmark); + end; + end; +end; + +procedure TLog.LogAnalyze(Text: string); +var + Seconds: integer; + Miliseconds: integer; + ValueText: string; +begin + if Ini.Debug = 1 then begin + + if not FileAnalyzeO then begin + AssignFile(FileAnalyze, LogPath + 'Analyze.log'); + {$I-} + Rewrite(FileAnalyze); + if IOResult = 0 then FileAnalyzeO := true; + {$I+} + end; + + if FileAnalyzeO then begin + WriteLn(FileAnalyze, Text); + Flush(FileAnalyze); // try to speed up + end; + + end; +end; + +procedure TLog.LogError(Text: string); +begin + if not FileErrorO then begin + FileErrorO := true; + AssignFile(FileError, LogPath + 'Error.log'); + {$I-} + Rewrite(FileError); + if IOResult = 0 then FileErrorO := true; + {$I+} + end; + + if FileErrorO then begin + WriteLn(FileError, Text); + Flush(FileError); + end; +end; + +procedure TLog.LogVoice(SoundNr: integer); +var + FileVoice: File; + FS: TFileStream; + FileName: string; + Num: integer; + BL: integer; +begin + for Num := 1 to 9999 do begin + FileName := IntToStr(Num); + while Length(FileName) < 4 do FileName := '0' + FileName; + FileName := LogPath + 'Voice' + FileName + '.raw'; + if not FileExists(FileName) then break + end; + + + FS := TFileStream.Create(FileName, fmCreate); + + for BL := 0 to High(Sound[SoundNr].BufferLong) do begin + Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); + FS.CopyFrom(Sound[SoundNr].BufferLong[BL], Sound[SoundNr].BufferLong[BL].Size); + end; + + FS.Free; +end; + +procedure TLog.LogStatus(Log1, Log2: string); +begin +//asd + LogError (Log2 + ': ' + Log1); +end; + +procedure TLog.LogError(Log1, Log2: string); +begin +//asd +end; + +procedure TLog.CriticalError(Text: string); +begin + //Write Error to Logfile: + LogError (Text); + + //Show Errormessage + Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); + + //Exit Application + Halt; +end; + +end. + \ No newline at end of file diff --git a/Game/Code/Classes/ULyrics.dcu b/Game/Code/Classes/ULyrics.dcu new file mode 100644 index 00000000..3867c263 Binary files /dev/null and b/Game/Code/Classes/ULyrics.dcu differ diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas new file mode 100644 index 00000000..c3b440bc --- /dev/null +++ b/Game/Code/Classes/ULyrics.pas @@ -0,0 +1,383 @@ +unit ULyrics; + +interface +uses SysUtils, OpenGL12, UMusic; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + public + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + Word[SelectedI].Done := 0; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; // new + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. diff --git a/Game/Code/Classes/UMain.dcu b/Game/Code/Classes/UMain.dcu new file mode 100644 index 00000000..3a2edf09 Binary files /dev/null and b/Game/Code/Classes/UMain.dcu differ diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas new file mode 100644 index 00000000..3ef65e1d --- /dev/null +++ b/Game/Code/Classes/UMain.pas @@ -0,0 +1,673 @@ +unit UMain; + +interface +uses SDL, UGraphic, UMusic, URecord, UTime, SysUtils, UDisplay, UIni, ULog, ULyrics, UScreenSing, + OpenGL12, zlportio {you can disable it and all PortWriteB calls}, ULCD, ULight, UThemes; + +type + TPlayer = record + Name: string; + + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreI: integer; + ScoreLineI: integer; + ScoreGoldenI: integer; + ScoreTotalI: integer; + + + + //SingBar Mod + ScoreLast: Real;//Last Line Score + ScorePercent: integer;//Aktual Fillstate of the SingBar + ScorePercentTarget: integer;//Target Fillstate of the SingBar + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + LineBonus_PosX: integer; + LineBonus_PosY: integer; + LineBonus_Alpha: Single; + LineBonus_Visible: boolean; + LineBonus_Text: string; + LineBonus_Color: TRGB; + + //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes + LineBonus_TargetX: integer; + LineBonus_TargetY: integer; + LineBonus_StartX: integer; + LineBonus_StartY: integer; + //PhrasenBonus - Line Bonus Mod End + + + + +// Meter: real; + + HighNut: integer; + IlNut: integer; + Nuta: array of record + Start: integer; + Dlugosc: integer; + Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute + Ton: real; + Perfect: boolean; // true if the note matches the original one, lit the star + + + + // Half size Notes Patch + Hit: boolean; // true if the note Hits the Line + //end Half size Notes Patch + + + + end; + end; + + +var + OGL: Boolean; + Done: Boolean; + Event: TSDL_event; + FileName: string; + Restart: boolean; + + // gracz i jego nuty + Player: array of TPlayer; + PlayersPlay: integer; + + +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Sender: TScreenSing); +procedure NewSentence(Sender: TScreenSing); +procedure NewBeat(Sender: TScreenSing); // executed when on then new beat +procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click +procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection +//procedure NewHalf; // executed when in the half between beats +procedure NewNote(Sender: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation +uses USongs, UJoystick, math; + +procedure MainLoop; +var + Delay: integer; +begin + SDL_EnableKeyRepeat(125, 125); + While not Done do + Begin + // joypad + if Ini.Joypad = 1 then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + Display.Draw; + SwapBuffers; + + // light + Light.Refresh; + + // delay + CountMidTime; +// if 1000*TimeMid > 100 then beep; + Delay := Floor(1000 / 100 - 1000 * TimeMid); + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + CountSkipTime; + + // reinitialization of graphics + if Restart then begin + Reinitialize3D; + Restart := false; + end; + + End; + UnloadOpenGL; +End; + +Procedure CheckEvents; +//var +// p: pointer; +Begin + if not Assigned(Display.NextScreen) then + While SDL_PollEvent( @event ) = 1 Do + Begin +// beep; + Case Event.type_ Of + SDL_QUITEV: done := true; +{ SDL_MOUSEBUTTONDOWN: + With Event.button Do + Begin + If State = SDL_BUTTON_LEFT Then + Begin + // + End; + End; // With} + SDL_KEYDOWN: + begin + if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)) then +// if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then + done := true; // exit game + end; +// SDL_JOYAXISMOTION: +// begin +// beep +// end; + SDL_JOYBUTTONDOWN: + begin + beep + end; + End; // Case Event.type_ + End; // While +End; // CheckEvents + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(AktSong.BPM) = BPMNum then begin + // last BPM + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end else begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then begin + // there is still remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end else begin + // there is no remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +// TopBeat: real; +// TempBeat: real; +// TempTime: real; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; + + (* 2 BPMs *) +{ if Length(AktSong.BPM) > 1 then begin + (* new system *) + CurBeat := 0; + TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); + if TopBeat > AktSong.BPM[1].StartBeat then begin + // analyze second BPM + Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); + CurBeat := AktSong.BPM[1].StartBeat; + TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); + Result := CurBeat + TopBeat; + + end else begin + (* pierwszy przedzial *) + Result := TopBeat; + end; + end; // if} + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end; // if +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + Result := AktSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin + // full range + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin + // in the middle + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + +{ while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end;} + end; // if} +end; + +procedure Sing(Sender: TScreenSing); +var + Pet: integer; + PetGr: integer; + CP: integer; + Done: real; + N: integer; +begin + Czas.Teraz := Czas.Teraz + TimeSkip; + + Czas.OldBeat := Czas.AktBeat; + Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.AktBeat := Floor(Czas.MidBeat); + +// Czas.OldHalf := Czas.AktHalf; +// Czas.MidHalf := Czas.MidBeat + 0.5; +// Czas.AktHalf := Floor(Czas.MidHalf); + + Czas.OldBeatC := Czas.AktBeatC; + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); + Czas.AktBeatC := Floor(Czas.MidBeatC); + + Czas.OldBeatD := Czas.AktBeatD; + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.AktBeatD := Floor(Czas.MidBeatD); + Czas.FracBeatD := Frac(Czas.MidBeatD); + + // sentences routines + for PetGr := 0 to 0 do begin;//High(Gracz) do begin + CP := PetGr; + // ustawianie starej czesci + Czas.OldCzesc := Czesci[CP].Akt; + + // wybieranie aktualnej czesci + for Pet := 0 to Czesci[CP].High do + if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; + + // czysczenie nut gracza, gdy to jest nowa plansza + // (optymizacja raz na halfbeat jest zla) + if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); + + end; // for PetGr + + // wykonuje operacje raz na beat + if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then + NewBeat(Sender); + + // make some operations on clicks + if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then + NewBeatC(Sender); + + // make some operations when detecting new voice pitch + if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then + NewBeatD(Sender); + + // wykonuje operacje w polowie beatu +// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then +// NewHalf; + + // plynnie przesuwa text + Done := 1; + for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) + and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then + Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); + + N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; + + // wylacza ostatnia nute po przejsciu + if (Ini.LyricsEffect = 1) and (Done = 1) and + (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) + then Sender.LyricMain.Selected := -1; + + if Done > 1 then Done := 1; + Sender.LyricMain.Done := Done; + + // use Done with LCD +{ with ScreenSing do begin + if LyricMain.Selected >= 0 then begin + LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); + LCD.ShowCursor; + end; + end;} + + +end; + +procedure NewSentence(Sender: TScreenSing); +var +G: Integer; +begin + // czyszczenie nut graczy + for G := 0 to High(Player) do begin + Player[G].IlNut := 0; + Player[G].HighNut := -1; + SetLength(Player[G].Nuta, 0); + end; + + // wstawianie tekstow + with Sender do begin + LyricMain.AddCzesc(Czesci[0].Akt); + if Czesci[0].Akt < Czesci[0].High then + LyricSub.AddCzesc(Czesci[0].Akt+1) + else + LyricSub.Clear; + end; + + Sender.UpdateLCD; +end; + +procedure NewBeat(Sender: TScreenSing); +var + Pet: integer; +// TempBeat: integer; +begin + // ustawia zaznaczenie tekstu +// SingScreen.LyricMain.Selected := -1; + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin + // operates on currently beated note + Sender.LyricMain.Selected := Pet; + +// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); +// LCD.ShowCursor; + + LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); + LCD.ShowCursor; + + end; +end; + +procedure NewBeatC; +var + Pet: integer; +// LPT_1: integer; +// LPT_2: integer; +begin +// LPT_1 := 1; +// LPT_2 := 1; + + // beat click + if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then + Music.PlayClick; + + // debug system on LPT + if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin + //LPT_1 := 0; +// Light.LightOne(0, 150); + + Light.LightOne(1, 200); // beat light + if ParamStr(1) = '-doublelights' then + Light.LightOne(0, 200); // beat light + + +{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then + Light.LightOne(0, 150) + else + Light.LightOne(1, 150)} + end; + + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin + // click assist + if Ini.ClickAssist = 1 then + Music.PlayClick; + + //LPT_2 := 0; + if ParamStr(1) <> '-doublelights' then + Light.LightOne(0, 150); //125 + + + // drum machine +(* TempBeat := Czas.AktBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; +// if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) + end; + + //PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala +end; + +procedure NewBeatD(Sender: TScreenSing); +begin + NewNote(Sender); +end; + +//procedure NewHalf; +//begin +// NewNote; +//end; + +procedure NewNote(Sender: TScreenSing); +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Pet: integer; + Mozna: boolean; + Nowa: boolean; + Range: integer; + NoteHit:boolean; +begin +// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); +// beep; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do begin + + // analyze buffer + Sound[CP].AnalizujBufor; + + // adds some noise +// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; + + // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Czesci[0].Akt-1; + if SMin < 0 then SMin := 0; + SMax := Czesci[0].Akt; + + // check if we can add new note + Mozna := false; + for S := SMin to SMax do + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) + and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 + then begin + SDet := S; + Mozna := true; + Break; + end; + + S := SDet; + + + + + +// Czas.SzczytJest := true; +// Czas.Ton := 27; + + // gdy moze, to dodaje nute + if (Sound[CP].SzczytJest) and (Mozna) then begin + // operowanie na ostatniej nucie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + Sound[CP].Ton := Sound[CP].Ton - 12; + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + Sound[CP].Ton := Sound[CP].Ton + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin + Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + + // Half size Notes Patch + NoteHit := true; + + + if (Ini.LineBonus = 0) then + begin + // add points without LineBonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end + else + begin + // add points with Line Bonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then begin + Nowa := true; + // jezeli ostatnia ma ten sam ton + if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) + then Nowa := false; + // jezeli jest jakas nowa nuta na sprawdzanym beacie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then + Nowa := true; + + // dodawanie nowej nuty + if Nowa then begin + // nowa nuta + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNut := Player[CP].HighNut + 1; + SetLength(Player[CP].Nuta, Player[CP].IlNut); + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; + Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + + + // Half Note Patch + Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; + + + // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); + + end else begin + // przedluzenie nuty + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; + end; + + + // check for perfect note and then lit the star (on Draw) + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) + and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin + Player[CP].Nuta[Player[CP].HighNut].Perfect := true; + end; + + end;// else beep; // if S = SMax + + end; // if moze + end; // for CP +// Log.LogStatus('EndBeat', 'NewBeat'); + +//On Sentence End -> For LineBonus + SingBar +if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then +if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then + Sender.onSentenceEnd(sDet); + +end; + +procedure ClearScores(PlayerNum: integer); +begin + Player[PlayerNum].Score := 0; + Player[PlayerNum].ScoreI := 0; + Player[PlayerNum].ScoreLine := 0; + Player[PlayerNum].ScoreLineI := 0; + Player[PlayerNum].ScoreGolden := 0; + Player[PlayerNum].ScoreGoldenI := 0; + Player[PlayerNum].ScoreTotalI := 0; + + + //SingBar Mod + Player[PlayerNum].ScoreLast := 0; + Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts + Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts + //end SingBar Mod + + //PhrasenBonus - Line Bonus Mod + Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus + Player[PlayerNum].LineBonus_Alpha := 0; + Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; + Player[PlayerNum].LineBonus_TargetY := 30; + //PhrasenBonus - Line Bonus Mod End + + + +end; + +end. + diff --git a/Game/Code/Classes/UMusic.dcu b/Game/Code/Classes/UMusic.dcu new file mode 100644 index 00000000..f3116f8b Binary files /dev/null and b/Game/Code/Classes/UMusic.dcu differ diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas new file mode 100644 index 00000000..db1675c5 --- /dev/null +++ b/Game/Code/Classes/UMusic.pas @@ -0,0 +1,783 @@ +unit UMusic; + +interface + +uses Classes, MPlayer, Windows, Messages, SysUtils, Forms, ULog, USongs, Bass;//, DXSounds; + +procedure InitializeSound; + +type + TSoundCard = record + Name: string; + Source: array of string; + end; + + TFFTData = array [0..256] of Single; + + TCustomSoundEntry = record + Filename: String; + Handle: hStream; + end; + + + TMusic = class + private +// MediaPlayer: TMediaPlayer; // It will be replaced by another component; +{ MediaPlayerStart: TMediaPlayer; // or maybe not if done this way ;) + MediaPlayerBack: TMediaPlayer; + MediaPlayerSwoosh: TMediaPlayer; + MediaPlayerChange: TMediaPlayer; + MediaPlayerOption: TMediaPlayer; + MediaPlayerClick: TMediaPlayer; + MediaPlayerDrum: TMediaPlayer; + MediaPlayerHihat: TMediaPlayer; + MediaPlayerClap: TMediaPlayer; + MediaPlayerShuffle: TMediaPlayer;} + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + + + Loaded: boolean; + Loop: boolean; +// DXSound: TDXSound; +// Player: TcmxMp3; + public + Bass: hStream; + +// SoundCard: array of TSoundCard; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadPlayerFromFile(var MediaPlayer: TMediaPlayer; Name: string): boolean; + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal); + +end; + +const + RecordSystem = 1; + +type + TMuzyka = record + Path: string; + Start: integer; // start of song in ms +// BPM: array of TBPM; +// Gap: real; + IlNut: integer; + DlugoscNut: integer; +// WartoscNut: integer; + end; + + TCzesci = record + Akt: integer; // aktualna czesc utworu do rysowania + High: integer; + Ilosc: integer; + Resolution: integer; + NotesGAP: integer; + Wartosc: integer; + Czesc: array of record + Start: integer; + StartNote: integer; + Lyric: string; + LyricWidth: real; + Koniec: integer; + BaseNote: integer; + HighNut: integer; + IlNut: integer; + TotalNotes: integer; + Nuta: array of record + Color: integer; + Start: integer; + Dlugosc: integer; + Ton: integer; + TonGamy: integer; + Tekst: string; + FreeStyle: boolean; + Wartosc: integer; // zwykla nuta x1, zlota nuta x2 + + + + + end; + end; + end; + + TCzas = record // wszystko, co dotyczy aktualnej klatki +// BajtowTotal: integer; +// BajtowTeraz: integer; +// BajtowNaSek: integer; + OldBeat: integer; // poprzednio wykryty beat w utworze + AktBeat: integer; // aktualny beat w utworze + MidBeat: real; // dokladny AktBeat + + // should not be used +// OldHalf: integer; // poprzednio wykryta polowka +// AktHalf: integer; // aktualna polowka w utworze +// MidHalf: real; // dokladny AktHalf + + // now we use this for super synchronization! + // only used when analyzing voice + OldBeatD: integer; // poprzednio wykryty beat w utworze + AktBeatD: integer; // aktualny beat w utworze + MidBeatD: real; // dokladny AktBeatD + FracBeatD: real; // fractional part of MidBeatD + + // we use this for audiable clicks + OldBeatC: integer; // poprzednio wykryty beat w utworze + AktBeatC: integer; // aktualny beat w utworze + MidBeatC: real; // dokladny AktBeatC + FracBeatC: real; // fractional part of MidBeatC + + + OldCzesc: integer; // poprzednio wyswietlana czesc + // akt jest w czesci.akt + + Teraz: real; // aktualny czas w utworze + Razem: real; // caly czas utworu +// TerazSek: integer; + end; + +var + Form: TForm; + Music: TMusic; + + // muzyka + Muzyka: TMuzyka; + + // czesci z nutami; + Czesci: array of TCzesci; + + // czas + Czas: TCzas; + + fHWND: Thandle; + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +implementation +uses UGraphic, URecord, UPliki, UIni, UMain, UThemes; + +procedure InitializeSound; +begin + Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; + Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; +end; + +procedure TMusic.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + Loaded := false; + Loop := false; + fHWND := AllocateHWND( nil); + + if not BASS_Init(1, 44100, 0, fHWND, nil) then begin + Application.MessageBox ('Could not initialize BASS', 'Error'); + Exit; + end; + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + +{ MediaPlayer := TMediaPlayer.Create( nil ); + MediaPlayer.ParentWindow := fHWND; + MediaPlayer.Wait := true;} + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + +{ LoadPlayerFromFile(MediaPlayerStart, SoundPath + 'Common Start.mp3'); + LoadPlayerFromFile(MediaPlayerBack, SoundPath + 'Common Back.mp3'); + LoadPlayerFromFile(MediaPlayerSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadPlayerFromFile(MediaPlayerChange, SoundPath + 'select music change music.mp3'); + LoadPlayerFromFile(MediaPlayerOption, SoundPath + 'option change col.mp3'); + LoadPlayerFromFile(MediaPlayerClick, SoundPath + 'rimshot022b.mp3'); + + LoadPlayerFromFile(MediaPlayerDrum, SoundPath + 'bassdrumhard076b.mp3'); + LoadPlayerFromFile(MediaPlayerHihat, SoundPath + 'hihatclosed068b.mp3'); + LoadPlayerFromFile(MediaPlayerClap, SoundPath + 'claps050b.mp3'); + + LoadPlayerFromFile(MediaPlayerShuffle, SoundPath + 'Shuffle.mp3');} + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TMusic.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TMusic.SetVolume(Volume: integer); +begin + BASS_SetVolume(Volume); +end; + +procedure TMusic.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TMusic.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then begin +{ MediaPlayer.FileName := Name; + MediaPlayer.Open;} + + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + Loaded := true; + end; + + Result := Loaded; + +// Player := TcmxMp3.Create(Name); +end; + +procedure TMusic.Rewind; +begin + if Loaded then begin +// MediaPlayer.Position := 0; + + end; +end; + +procedure TMusic.MoveTo(Time: real); +var + bytes: integer; +begin +// if Loaded then begin +// MediaPlayer.StartPos := Round(Time); + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); +// end; +end; + +procedure TMusic.Play; +begin + if Loaded then begin +// MediaPlayer.Play; + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; +end; + +procedure TMusic.Pause; //Pause Mod +begin + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; +end; + +procedure TMusic.Stop; +begin + Bass_ChannelStop(Bass); +// Bass_StreamFree(Bass); +// if ModeStr[MediaPlayer.Mode] = 'Playing' then begin +// MediaPlayer.Stop; +// end; +end; + +procedure TMusic.Close; +begin + Bass_StreamFree(Bass); +// Player.Free; +// MediaPlayer.Close; +end; + +function TMusic.Length: real; +var + bytes: integer; +begin + Result := 60; + + bytes := BASS_StreamGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); + +{ if Assigned(MediaPlayer) then begin + if Loaded then Result := MediaPlayer.Length / 1000; + end;} +// if Assigned(Player) then +// Result := Player.LengthInSeconds; +end; + +function TMusic.Position: real; +var + bytes: integer; +begin + Result := 0;//MediaPlayer.Position / 1000; + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +end; + +function TMusic.Finished: boolean; +begin + Result := false; +// if ModeStr[MediaPlayer.Mode] = 'Stopped' then Result := true; + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then begin +// beep; + Result := true; + end; +end; + +{function myeffect( chan : integer; stream : Pointer; len : integer; udata : Pointer ): Pointer; cdecl; +var + dane: pwordarray; + pet: integer; + Prev: smallint; + PrevNew: smallint; +begin + dane := stream; + Prev := 0; + for pet := 0 to len div 2 -1 do begin + PrevNew := Dane[Pet]; + +// Dane[pet] := Round(PrevNew*1/8 + Prev*7/8); + + Prev := Dane[Pet]; + end; +end;} + +procedure TMusic.PlayStart; +{var + Music: PMix_Chunk;} +begin +{ Mix_OpenAudio(44100, 16, 1, 16*1024); + Music := Mix_LoadWAV('D:\Rozne\UltraStar\Old\Boys - Hej Sokoly 30s.wav'); + Mix_RegisterEffect(0, myeffect, nil, 0); + Mix_PlayChannel(0, Music, 0);} + +// MediaPlayerStart.Rewind; +// MediaPlayerStart.Play; + BASS_ChannelPlay(BassStart, True); +end; + +procedure TMusic.PlayBack; +begin +// MediaPlayerBack.Rewind; +// MediaPlayerBack.Play; +// if not + BASS_ChannelPlay(BassBack, True);// then +// Application.MessageBox ('Error playing stream!', 'Error'); +end; + +procedure TMusic.PlaySwoosh; +begin +// MediaPlayerSwoosh.Rewind; +// MediaPlayerSwoosh.Play; + BASS_ChannelPlay(BassSwoosh, True); +end; + +procedure TMusic.PlayChange; +begin +// MediaPlayerChange.Rewind; +// MediaPlayerChange.Play; + BASS_ChannelPlay(BassChange, True); +end; + +procedure TMusic.PlayOption; +begin +// MediaPlayerOption.Rewind; +// MediaPlayerOption.Play; + BASS_ChannelPlay(BassOption, True); +end; + +procedure TMusic.PlayClick; +begin +// MediaPlayerClick.Rewind; +// MediaPlayerClick.Play; + BASS_ChannelPlay(BassClick, True); +end; + +procedure TMusic.PlayDrum; +begin +// MediaPlayerDrum.Rewind; +// MediaPlayerDrum.Play; + BASS_ChannelPlay(BassDrum, True); +end; + +procedure TMusic.PlayHihat; +begin +// MediaPlayerHihat.Rewind; +// MediaPlayerHihat.Play; + BASS_ChannelPlay(BassHihat, True); +end; + +procedure TMusic.PlayClap; +begin +// MediaPlayerClap.Rewind; +// MediaPlayerClap.Play; + BASS_ChannelPlay(BassClap, True); +end; + +procedure TMusic.PlayShuffle; +begin +// MediaPlayerShuffle.Rewind; +// MediaPlayerShuffle.Play; + BASS_ChannelPlay(BassShuffle, True); +end; + +procedure TMusic.StopShuffle; +begin + BASS_ChannelStop(BassShuffle); +end; + +procedure TMusic.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + +{ case PlayersPlay of + 1: begin + CaptureCard(0, 0, 1, 0); + end; + 2: begin + if Ini.TwoPlayerMode = 0 then begin + CaptureCard(0, 0, 1, 2); + end else begin + CaptureCard(0, 0, 1, 0); + CaptureCard(1, 1, 2, 0); + end; + end; + 3: begin + CaptureCard(0, 0, 1, 2); + CaptureCard(1, 1, 3, 0); + end; + end; // case} + +// CaptureCard(0, 0, 0, 0); +// end; + + {for SC := 0 to High(SoundCard) do begin + P1 := Ini.SoundCard[SC, 1]; + P2 := Ini.SoundCard[SC, 2]; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + CaptureCard(SC, P1, P2); + end; } + // 0.5.2: new + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TMusic.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin +{ if RecordSystem = 1 then begin + case PlayersPlay of + 1: begin + StopCard(0); + end; + 2: begin + if Ini.TwoPlayerMode = 0 then begin + StopCard(0); + end else begin + StopCard(0); + StopCard(1); + end; + end; + 3: begin + StopCard(0); + StopCard(1); + end; + end; + end;} + + {for SC := 0 to High(SoundCard) do begin + StopCard(SC); + end; } + + // 0.5.2 + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + if not BASS_RecordInit(RecordI) then begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end else begin + + //SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + + {if SoundCard[RecordI].BassRecordStream = 0 then begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_INIT then ErrorMsg := 'Not successfully called'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'Recording is already in progress'; + if Error = BASS_ERROR_NOTAVAIL then ErrorMsg := 'The recording device is not available'; + if Error = BASS_ERROR_FORMAT then ErrorMsg := 'The specified format is not supported'; + if Error = BASS_ERROR_MEM then ErrorMsg := 'There is insufficent memory'; + if Error = BASS_ERROR_UNKNOWN then ErrorMsg := 'Unknown'; + + Log.LogError('Error creating record stream [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + end; } + end; +end; + +procedure TMusic.StopCard(Card: byte); +begin + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + +function TMusic.LoadPlayerFromFile(var MediaPlayer: TMediaPlayer; Name: string): boolean; +begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadPlayerFromFile'); + if FileExists(Name) then begin + try + MediaPlayer := TMediaPlayer.Create( nil ); + except + Log.LogError('Failed to create MediaPlayer', 'LoadPlayerFromFile'); + end; + try + MediaPlayer.ParentWindow := fHWND; + MediaPlayer.Wait := true; + MediaPlayer.FileName := Name; + MediaPlayer.DeviceType := dtAutoSelect; + MediaPlayer.Display := nil; + except + Log.LogError('Failed setting MediaPlayer: ' + MediaPlayer.ErrorMessage, 'LoadPlayerFromFile'); + end; + try + MediaPlayer.Open; + except + Log.LogError('Failed to open using MediaPlayer', 'LoadPlayerFromFile'); + end; + end else begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadPlayerFromFile'); + exit; + end; +end; + +function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +begin + if FileExists(Name) then begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadPlayerFromFile'); + try + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + except + Log.LogError('Failed to open using BASS', 'LoadPlayerFromFile'); + end; + end else begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadPlayerFromFile'); + exit; + end; +end; + +//Equalizer +function TMusic.GetFFTData: TFFTData; +var +Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + //Result := Data; +end; + +function TMusic.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TMusic.PlayCustomSound(const Index: Cardinal); +begin +if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); +end; + + +end. diff --git a/Game/Code/Classes/UParty.dcu b/Game/Code/Classes/UParty.dcu new file mode 100644 index 00000000..e3e1a901 Binary files /dev/null and b/Game/Code/Classes/UParty.dcu differ diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas new file mode 100644 index 00000000..da89ca8a --- /dev/null +++ b/Game/Code/Classes/UParty.pas @@ -0,0 +1,204 @@ +unit UParty; + +interface + +uses ModiSDK; + +type + TRoundInfo = record + Plugin: Word; + Winner: Byte; + end; + + TParty_Session = class + private + function GetRandomPlayer(Team: Byte): Byte; + function IsWinner(Player, Winner: Byte): boolean; + procedure GenScores; + public + Teams: TTeamInfo; + Rounds: array of TRoundInfo; + CurRound: Byte; + + constructor Create; + + procedure StartNewParty; + procedure StartRound; + procedure EndRound; + function GetWinner: Byte; + function GetWinnerString(Round: Byte): String; + end; + +var + PartySession: TParty_Session; + +implementation + +uses UDLLManager, UGraphic, UMain, ULanguage, ULog; + +//---------- +//Constructor - Prepares the Class +//---------- +constructor TParty_Session.Create; +begin +// - Nothing in here atm +end; + +//---------- +//StartNewParty - Clears the Class and Prepares for new Party +//---------- +procedure TParty_Session.StartNewParty; +begin +//Set cur Round to Round 1 +CurRound := 255; + +PlayersPlay := Teams.NumTeams; +if isWinner(0,9) then + Log.LogError('Test'); +end; + +//---------- +//GetRandomPlayer - Gives back a Random Player to Play next Round +//---------- +function TParty_Session.GetRandomPlayer(Team: Byte): Byte; +var + I, J: Integer; + lowestTP: Byte; +begin + //Get lowest TP + lowestTP := high(Byte); + J := -1; + for I := 0 to Teams.Teaminfo[Team].NumPlayers do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + J := I; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + J := -1; + end; + end; + + //If more than one Person has lowestTP then Select Random Player + if (J < 0) then + repeat + Result := Random(Teams.Teaminfo[Team].NumPlayers); + until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) + else //Else Select the one wth lowest TP + Result:= J; +end; + +//---------- +//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin +//---------- +procedure TParty_Session.StartRound; +var + I: Integer; +begin + if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin + //Increase Current Round + Inc (CurRound); + + Rounds[CurRound].Winner := 0; + DllMan.LoadPlugin(Rounds[CurRound].Plugin); + + //Select Players + for I := 0 to Teams.NumTeams do + Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + + //Set ScreenSingModie Variables + ScreenSingModi.TeamInfo := Teams; + + //Set + end; +end; + +//---------- +//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//---------- +function TParty_Session.IsWinner(Player, Winner: Byte): boolean; +var + Bit: Byte; +begin + Case Player of + 0: Bit := 1; + 1: Bit := 2; + 2: Bit := 4; + 3: Bit := 8; + 4: Bit := 16; + 5: Bit := 32; + end; + + Result := ((Winner AND Bit) = Bit); +end; + +//---------- +//GenScores - Inc Scores for Cur. Round +//---------- +procedure TParty_Session.GenScores; +var + I: Byte; +begin + for I := 0 to Teams.NumTeams do + begin + if isWinner(I, Rounds[CurRound].Winner) then + Inc(Teams.Teaminfo[I].Score); + end; +end; + +//---------- +//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , +//---------- +function TParty_Session.GetWinnerString(Round: Byte): String; +var + Winners: Array of String; + I: Integer; +begin + if (Rounds[Round].Winner = 0) then + begin + Result := 'Nobody'; + exit; + end; + + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams do + begin + if isWinner(I, Rounds[Round].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; + end; + end; + Result := Language.Implode(Winners); +end; + +//---------- +//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray +//---------- +procedure TParty_Session.EndRound; +var + I: Integer; +begin + //Copy Winner + Rounds[CurRound].Winner := ScreenSingModi.Winner; + //Set Scores + GenScores; + + //Increase TimesPlayed 4 all Players + For I := 0 to Teams.NumTeams do + Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[0].CurPlayer].TimesPlayed); + +end; + +//---------- +//Get Winner - Gives back the Number of the total Winner +//---------- +function TParty_Session.GetWinner: Byte; +begin + +end; + +end. diff --git a/Game/Code/Classes/UPliki.dcu b/Game/Code/Classes/UPliki.dcu new file mode 100644 index 00000000..1798b6f8 Binary files /dev/null and b/Game/Code/Classes/UPliki.dcu differ diff --git a/Game/Code/Classes/UPliki.pas b/Game/Code/Classes/UPliki.pas new file mode 100644 index 00000000..475a3752 --- /dev/null +++ b/Game/Code/Classes/UPliki.pas @@ -0,0 +1,830 @@ +unit UPliki; + +interface + +uses USongs, SysUtils, ULog, UMusic; + +procedure InitializePaths; +function ReadHeader(var Song: TSong): boolean; +function SkanujPlik(var Song: TSong): boolean; +procedure CzyscNuty; +function WczytajCzesci(Name: string): boolean; +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; + +var + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + + Plik: TextFile; // all procedures in this unit operates on this file + PlikC: char; + Lineno: integer; + + // variables available for all procedures + Base: array[0..1] of integer; + Rel: array[0..1] of integer; + Mult: integer; + MultBPM: integer; + +implementation +uses TextGL, UIni, UMain, math; + +procedure InitializePaths; +begin + GamePath := ExtractFilePath(ParamStr(0)); + SoundPath := GamePath + 'Sounds\'; + SongPath := GamePath + 'Songs\'; + LogPath := GamePath; + ThemePath := GamePath + 'Themes\'; + ScreenshotsPath := GamePath + 'Screenshots\'; + CoversPath := GamePath + 'Covers\'; + LanguagesPath := GamePath + 'Languages\'; + //Modi Loader + PluginPath := GamePath + 'Plugins\'; + + DecimalSeparator := ','; +end; + +function ReadHeader(var Song: TSong): boolean; +var + TempC: char; + Tekst: string; + Done: integer; +begin + // clear + Song.Title := ''; + Song.Artist := ''; + Song.Genre := 'Unknown'; + Song.Edition := 'Unknown'; + Song.Language := 'Unknown'; //Language Patch + Song.Mp3 := ''; + Song.BPM := 0; + Song.GAP := 0; + Song.Start := 0; + Song.Finish := 0; + Song.Background := ''; + Song.Video := ''; + Song.VideoGAP := 0; + Song.NotesGAP := 0; + Song.Resolution := 4; + + //Creator Patch + Song.Creator := ''; + + Done := 0; + + //Editor Error Reporting Hack + LineNo := 0; + try + + // read + Read(Plik, PlikC); + while (PlikC = '#') do begin + ReadLn(Plik, Tekst); + + //Editor Error Reporting Hack + Inc (LineNo); + + //Header Improvements Patch + + if UpperCase(Copy(Tekst, 1, 6)) = 'TITLE:' then begin + Delete(Tekst, 1, 6); + Song.Title := Trim(Tekst); + Tekst := ''; + Done := Done or 1; + end + + else if UpperCase(Copy(Tekst, 1, 7)) = 'ARTIST:' then begin + Delete(Tekst, 1, 7); + Song.Artist := Trim(Tekst); + Tekst := ''; + Done := Done or 2; + end + + else if UpperCase(Copy(Tekst, 1, 4)) = 'MP3:' then begin + Delete(Tekst, 1, 4); + Song.Mp3 := Trim(Tekst); + Tekst := ''; + Done := Done or 4; + end + + else if UpperCase(Copy(Tekst, 1, 8)) = 'CREATOR:' then begin // this goes for edit + Delete(Tekst, 1, 8); + Song.Creator := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 6)) = 'GENRE:' then begin // this goes for edit + Delete(Tekst, 1, 6); + Song.Genre := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 8)) = 'EDITION:' then begin // this goes for edit + Delete(Tekst, 1, 8); + Song.Edition := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 9)) = 'LANGUAGE:' then begin // this goes for edit + Delete(Tekst, 1, 9); + Song.Language := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 6)) = 'COVER:' then begin + Delete(Tekst, 1, 6); + Song.Cover := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 11)) = 'BACKGROUND:' then begin + Delete(Tekst, 1, 11); + Song.Background := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 6)) = 'VIDEO:' then begin + Delete(Tekst, 1, 6); + Song.Video := Trim(Tekst); + Tekst := ''; + end + + else if UpperCase(Copy(Tekst, 1, 9)) = 'VIDEOGAP:' then begin + Delete(Tekst, 1, 9); + + //Change . to , Mod by Whiteshark :P + if (Pos('.',Tekst) <> 0) then + begin + Tekst[Pos('.',Tekst)] := ','; + //Little Annonce for the User + Log.LogError('VideoGap Seperator wrong in SongHeader: ' + Song.FileName + ' [Corrected for this Session]'); + end; + + Song.VideoGAP := StrToFloat(Tekst); + Tekst := '' + end + + else if UpperCase(Copy(Tekst, 1, 9)) = 'NOTESGAP:' then begin + Delete(Tekst, 1, 9); + Song.NotesGAP := StrToInt(Tekst); + Tekst := '' + end + + else if UpperCase(Copy(Tekst, 1, 9)) = 'RELATIVE:' then begin + Delete(Tekst, 1, 9); + if LowerCase(Tekst) = 'yes' then Song.Relative := true; + end + + else if UpperCase(Copy(Tekst, 1, 6)) = 'START:' then begin + Delete(Tekst, 1, 6); + Song.Start := StrToFloat(Tekst); +// Muzyka.Start := StrToInt(Tekst); + end + + else if UpperCase(Copy(Tekst, 1, 4)) = 'END:' then begin + Delete(Tekst, 1, 4); + Song.Finish := StrToInt(Tekst); + end + + else if UpperCase(Copy(Tekst, 1, 11)) = 'RESOLUTION:' then begin + Delete(Tekst, 1, 11); + Song.Resolution := StrToInt(Tekst); + end + + else if UpperCase(Copy(Tekst, 1, 4)) = 'BPM:' then begin + Delete(Tekst, 1, 4); + +// Muzyka.BPMOld := StrToFloat(Tekst) * Mult * MultBPM; // old system + + (* new system with variable BPM *) +// Muzyka.BPMOld := 50; + + //Change . to , Mod by Whiteshark :P + if (Pos('.',Tekst) <> 0) then + begin + Tekst[Pos('.',Tekst)] := ','; + //Little Annonce for the User + Log.LogError('BPM Seperator wrong in SongHeader: ' + Song.FileName + ' [Corrected for this Session]'); + end; + + SetLength(Song.BPM, 1); + Song.BPM[0].StartBeat := 0; + Song.BPM[0].BPM := StrToFloat(Tekst) * Mult * MultBPM; + Tekst := ''; + Done := Done or 8; + end + + else if UpperCase(Copy(Tekst, 1, 4)) = 'GAP:' then begin + Delete(Tekst, 1, 4); + Song.GAP := StrToFloat(Tekst); + Tekst := ''; +// Muzyka.GAP := StrToFloat(Tekst); +// Done := Done or 16; + end; + + //Header Improvements Patch Ende + + Read(Plik, PlikC); + end; + + //Editor Error Reporting Hack + except //An Error happened<- bad english :P + Log.LogError('An Error occured reading Line ' + inttostr(LineNo) + ' from SongHeader: ' + Song.FileName); + Halt; + end; + //Editor Error Reporting Hack End + + if Song.Background = '' then begin + Song.Background := Songs.FindSongFile(Song.Path, '*[BG].jpg'); + end; + + if (Done and 15) = 15 then Result := true + else Result := false; +end; + +function SkanujPlik(var Song: TSong): boolean; +var + Done: integer; + Tekst: string; + C: integer; // category + P: integer; // position +begin +// try + AssignFile(Plik, Song.Path + Song.FileName); + Reset(Plik); + + Result := ReadHeader(Song); + +{ ReadLn(Plik, Tekst); + while (Copy(Tekst, 1, 1) = '#') do begin + if Copy(Tekst, 1, 10) = '#CATEGORY:' then begin + Delete(Tekst, 1, 10); + + Trim(Tekst); + while (Length(Tekst) > 0) do begin + C := Length(Song.Category); + SetLength(Song.Category, C+1); + + P := Pos(',', Tekst); + if P = 0 then P := Length(Tekst); + Song.Category[C] := Copy(Tekst, 1, P); + + Delete(Tekst, 1, P); + Trim(Tekst); + end; + + end;} + + +end; + +procedure CzyscNuty; +var + Pet: integer; +begin + SetLength(Czesci, Length(Player)); + SetLength(AktSong.BPM, 0); + for Pet := 0 to High(Player) do begin + SetLength(Czesci[Pet].Czesc, 1); + SetLength(Czesci[Pet].Czesc[0].Nuta, 0); + Czesci[Pet].Czesc[0].Lyric := ''; + Czesci[Pet].Czesc[0].LyricWidth := 0; + Player[pet].Score := 0; + Player[pet].IlNut := 0; + Player[pet].HighNut := -1; + end; +end; + +procedure DodajNute(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +var + Space: boolean; +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + +// Log.LogStatus('Czesc: ' + IntToStr(Czesci[NrCzesci].High), 'DodajNute'); +// Log.LogStatus('Dodano: [' + IntToStr(NrCzesci) + '] ' + IntToStr(StartP) + ' ' +// + IntToStr(DurationP) + ' '+ IntToStr(NoteP) + ' ' + LyricS, 'DodajNute'); + +{ Delete(LyricS, 1, 1); + Space := false; + if Copy(LyricS, Length(LyricS), 1) = ' ' then begin + Space := true; + Delete(LyricS, Length(LyricS), 1); + end; + if LyricS = 'a' then LyricS := chr($B1); + if LyricS = 'i' then LyricS := chr($B2); + if LyricS = 'u' then LyricS := chr($B3); + if LyricS = 'e' then LyricS := chr($B4); + if LyricS = 'o' then LyricS := chr($B5); + + if LyricS = 'ka' then LyricS := chr($B6); + if LyricS = 'ki' then LyricS := chr($B7); + if LyricS = 'ku' then LyricS := chr($B8); + if LyricS = 'ke' then LyricS := chr($B9); + if LyricS = 'ko' then LyricS := chr($BA); + + if LyricS = 'ga' then LyricS := chr($B6) + chr($DE); + if LyricS = 'gi' then LyricS := chr($B7) + chr($DE); + if LyricS = 'gu' then LyricS := chr($B8) + chr($DE); + if LyricS = 'ge' then LyricS := chr($B9) + chr($DE); + if LyricS = 'go' then LyricS := chr($BA) + chr($DE); + + if LyricS = 'sa' then LyricS := chr($BB); + if LyricS = 'shi' then LyricS := chr($BC); + if LyricS = 'su' then LyricS := chr($BD); + if LyricS = 'se' then LyricS := chr($BE); + if LyricS = 'so' then LyricS := chr($BF); + + if LyricS = 'za' then LyricS := chr($BB) + chr($DE); + if LyricS = 'ji' then LyricS := chr($BC) + chr($DE); + if LyricS = 'zu' then LyricS := chr($BD) + chr($DE); + if LyricS = 'ze' then LyricS := chr($BE) + chr($DE); + if LyricS = 'zo' then LyricS := chr($BF) + chr($DE); + + if LyricS = 'ta' then LyricS := chr($C0); + if LyricS = 'chi' then LyricS := chr($C1); + if LyricS = 'tsu' then LyricS := chr($C2); + if LyricS = 'te' then LyricS := chr($C3); + if LyricS = 'to' then LyricS := chr($C4); + + if LyricS = 'da' then LyricS := chr($C0) + chr($DE); +// if LyricS = 'ji' then LyricS := chr($C1) + chr($DE); +// if LyricS = 'zu' then LyricS := chr($C2) + chr($DE); + if LyricS = 'de' then LyricS := chr($C3) + chr($DE); + if LyricS = 'do' then LyricS := chr($C4) + chr($DE); + + if LyricS = 'na' then LyricS := chr($C5); + if LyricS = 'ni' then LyricS := chr($C6); + if LyricS = 'nu' then LyricS := chr($C7); + if LyricS = 'ne' then LyricS := chr($C8); + if LyricS = 'no' then LyricS := chr($C9); + + if LyricS = 'ha' then LyricS := chr($CA); + if LyricS = 'hi' then LyricS := chr($CB); + if LyricS = 'hu' then LyricS := chr($CC); + if LyricS = 'he' then LyricS := chr($CD); + if LyricS = 'ho' then LyricS := chr($CE); + + if LyricS = 'ba' then LyricS := chr($CA) + chr($DE); + if LyricS = 'bi' then LyricS := chr($CB) + chr($DE); + if LyricS = 'bu' then LyricS := chr($CC) + chr($DE); + if LyricS = 'be' then LyricS := chr($CD) + chr($DE); + if LyricS = 'bo' then LyricS := chr($CE) + chr($DE); + + if LyricS = 'pa' then LyricS := chr($CA) + chr($DF); + if LyricS = 'pi' then LyricS := chr($CB) + chr($DF); + if LyricS = 'pu' then LyricS := chr($CC) + chr($DF); + if LyricS = 'pe' then LyricS := chr($CD) + chr($DF); + if LyricS = 'po' then LyricS := chr($CE) + chr($DF); + + if LyricS = 'ma' then LyricS := chr($CF); + if LyricS = 'mi' then LyricS := chr($D0); + if LyricS = 'mu' then LyricS := chr($D1); + if LyricS = 'me' then LyricS := chr($D2); + if LyricS = 'mo' then LyricS := chr($D3); + + if LyricS = 'ya' then LyricS := chr($D4); + if LyricS = 'yu' then LyricS := chr($D5); + if LyricS = 'yo' then LyricS := chr($D6); + + if LyricS = 'ra' then LyricS := chr($D7); + if LyricS = 'ri' then LyricS := chr($D8); + if LyricS = 'ru' then LyricS := chr($D9); + if LyricS = 're' then LyricS := chr($DA); + if LyricS = 'ro' then LyricS := chr($DB); + + if LyricS = 'wa' then LyricS := chr($DC); + if LyricS = 'n' then LyricS := chr($DD); + + LyricS := ' ' + LyricS; + if Space then LyricS := LyricS + ' ';} + + + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin + SetLength(Nuta, Length(Nuta) + 1); + IlNut := IlNut + 1; + HighNut := HighNut + 1; + Muzyka.IlNut := Muzyka.IlNut + 1; + + Nuta[HighNut].Start := StartP; + if IlNut = 1 then begin + StartNote := Nuta[HighNut].Start; + if Czesci[NrCzesci].Ilosc = 1 then + Start := -100; +// Start := Nuta[HighNut].Start; + end; + + Nuta[HighNut].Dlugosc := DurationP; + Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Nuta[HighNut].Wartosc := 0; + ':': Nuta[HighNut].Wartosc := 1; + '*': Nuta[HighNut].Wartosc := 2; + end; + Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; + + Nuta[HighNut].Ton := NoteP; + if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; + Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; + + Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); + Lyric := Lyric + Nuta[HighNut].Tekst; + + if TypeP = 'F' then + Nuta[HighNut].FreeStyle := true; + + Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; + end; // with +end; + +procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); +var +I: Integer; +begin +// Log.LogStatus('IlCzesci: ' + IntToStr(Czesci[NrCzesciP].Ilosc), 'NewSentece'); +// Log.LogStatus('Dane: ' + IntToStr(NrCzesciP) + ' ' + IntToStr(Param1) + ' ' + IntToStr(Param2) , 'NewSentece'); + + // stara czesc //Alter Satz //Update Old Part + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); + + //Total Notes Patch + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; + for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + end; + //Log.LogError('Total Notes(' + inttostr(Czesci[NrCzesciP].High) +'): ' + inttostr(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes)); + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); + Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; + Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; + + if not AktSong.Relative then + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + + if AktSong.Relative then begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; + end; + + Base[NrCzesciP] := 100; // high number +end; + +function WczytajCzesci(Name: string): boolean; +var + TempC: char; + Tekst: string; + CP: integer; // Current Player (0 or 1) + Pet: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Name) then begin + Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci'); + exit; + end; + + try + MultBPM := 4; // 4 - mnoznik dla czasu nut + Mult := 1; // 4 - dokladnosc pomiaru nut + Base[0] := 100; // high number +// Base[1] := 100; // high number + Czesci[0].Wartosc := 0; +// Czesci[1].Wartosc := 0; // here was the error in 0.3.2 + AktSong.Relative := false; + + Rel[0] := 0; +// Rel[1] := 0; + CP := 0; + Both := false; + if Length(Player) = 2 then Both := true; + + FileMode := fmOpenRead; + AssignFile(Plik, Name); + Reset(Plik); + + ReadHeader(AktSong); +(* if AktSong.Title = 'Hubba Hubba Zoot Zoot' then begin + Mult := 2; + AktSong.BPM[0].BPM := AktSong.BPM[0].BPM * 2; + end;*) + + SetLength(Czesci, 2); + for Pet := 0 to High(Czesci) do begin + SetLength(Czesci[Pet].Czesc, 1); + Czesci[Pet].High := 0; + Czesci[Pet].Ilosc := 1; + Czesci[Pet].Akt := 0; + Czesci[Pet].Resolution := AktSong.Resolution; + Czesci[Pet].NotesGAP := AktSong.NotesGAP; + Czesci[Pet].Czesc[0].IlNut := 0; + Czesci[Pet].Czesc[0].HighNut := -1; + end; + +// TempC := ':'; + TempC := PlikC; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') do begin + Inc(LineNo); + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // wczytuje nute + Read(Plik, Param1); + Read(Plik, Param2); + Read(Plik, Param3); + Read(Plik, ParamS); + + // dodaje nute + if not Both then + // P1 + DodajNute(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + DodajNute(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + DodajNute(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; // if + if TempC = '-' then begin + // reads sentence + Read(Plik, Param1); + if AktSong.Relative then Read(Plik, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + + end; // if + + if TempC = 'B' then begin + SetLength(AktSong.BPM, Length(AktSong.BPM) + 1); + Read(Plik, AktSong.BPM[High(AktSong.BPM)].StartBeat); + AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0]; + + Read(Plik, Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then begin + Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; + Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); + //Total Notes Patch + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; + for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do + begin + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end else begin + for Pet := 0 to High(Czesci) do begin + Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; + Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); + //Total Notes Patch + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; + for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do + begin + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end; + end; + + Read(Plik, TempC); + end; // while} + + CloseFile(Plik); + except + Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(LineNo)); + exit; + end; + + Result := true; +end; + +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + B: integer; + RelativeSubTime: integer; + NoteState: String; + +begin +// Relative := true; // override (idea - use shift+S to save with relative) + AssignFile(Plik, Name); + Rewrite(Plik); + + WriteLn(Plik, '#TITLE:' + Song.Title + ''); + WriteLn(Plik, '#ARTIST:' + Song.Artist); + + if Song.Creator <> '' then WriteLn(Plik, '#CREATOR:' + Song.Creator); + if Song.Edition <> 'Unknown' then WriteLn(Plik, '#EDITION:' + Song.Edition); + if Song.Genre <> 'Unknown' then WriteLn(Plik, '#GENRE:' + Song.Genre); + if Song.Language <> 'Unknown' then WriteLn(Plik, '#LANGUAGE:' + Song.Language); + if Song.Cover <> '' then WriteLn(Plik, '#COVER:' + Song.Cover); + + WriteLn(Plik, '#MP3:' + Song.Mp3); + + if Song.Background <> '' then WriteLn(Plik, '#BACKGROUND:' + Song.Background); + if Song.Video <> '' then WriteLn(Plik, '#VIDEO:' + Song.Video); + if Song.VideoGAP <> 0 then WriteLn(Plik, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then WriteLn(Plik, '#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then WriteLn(Plik, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then WriteLn(Plik, '#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then WriteLn(Plik, '#END:' + IntToStr(Song.Finish)); + if Relative then WriteLn(Plik, '#RELATIVE:yes'); + + WriteLn(Plik, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + WriteLn(Plik, '#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(AktSong.BPM) do + WriteLn(Plik, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4)); + + for C := 0 to Czesc.High do begin + for N := 0 to Czesc.Czesc[C].HighNut do begin + with Czesc.Czesc[C].Nuta[N] do begin + + + //Golden + Freestyle Note Patch + case Czesc.Czesc[C].Nuta[N].Wartosc of + 0: NoteState := 'F '; + 1: NoteState := ': '; + 2: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst; + + + WriteLn(Plik, S); + end; // with + end; // N + + if C < Czesc.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start) + else begin + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime); + RelativeSubTime := Czesc.Czesc[C+1].Start; + end; + WriteLn(Plik, S); + end; + + end; // C + + + WriteLn(Plik, 'E'); + CloseFile(Plik); +end; + +function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + STon: integer; + SLen: integer; + NTot: integer; + PlikB: TextFile; + LastTime: integer; +begin + AssignFile(Plik, Name); + Rewrite(Plik); + + AssignFile(PlikB, 'C:\song db.asm'); + Rewrite(PlikB); + + NTot := 0; + LastTime := 0; + + for C := 0 to Czesc.High do begin + WriteLn(Plik, '; ' + IntToStr(C)); + + for N := 0 to Czesc.Czesc[C].HighNut do begin + with Czesc.Czesc[C].Nuta[N] do begin + + // timespace + if LastTime < Start then begin + STon := 0; + SLen := Round((Start - LastTime) * 16320 / 255 / 12); + WriteLn(PlikB, ' .dw ' + IntToStr(STon + SLen*256) + ' ; timespace (0, ' + IntToStr(SLen) + ')'); + + end; + + + + // ton + STon := Round(98940/(2*261.62*Power(1.05946309436, Ton))); + S := ' ldi R18, ' + IntToStr(STon); + if STon > 255 then begin + beep; + S := '!!!!' + S; + end; + WriteLn(Plik, S); + + // length + //ldi R19, 43 + SLen := Round(Dlugosc * 16320 / STon / 12); + S := ' ldi R19, ' + IntToStr(SLen); + if SLen > 255 then begin + beep; + S := '!!!!' + S; + end; + WriteLn(Plik, S); + + // function + S := ' rcall playtone'; + WriteLn(Plik, S); + + // song dw + WriteLn(PlikB, ' .dw ' + IntToStr(STon + SLen*256)); + + + LastTime := Start + Dlugosc; + Inc(NTot); + + end; // with + end; // N + WriteLn(Plik, ''); + WriteLn(PlikB, ''); + end; // C + + WriteLn(Plik, '; nut ' + IntToStr(NTot)); + WriteLn(Plik, '; bajtów ' + IntToStr(8*NTot)); + + WriteLn(PlikB, ' .dw 0'); + WriteLn(PlikB, '; nut ' + IntToStr(NTot)); + WriteLn(PlikB, '; bajtów ' + IntToStr(2*NTot)); + + + CloseFile(Plik); + CloseFile(PlikB); +end; + +end. diff --git a/Game/Code/Classes/URecord.dcu b/Game/Code/Classes/URecord.dcu new file mode 100644 index 00000000..d28aa4b1 Binary files /dev/null and b/Game/Code/Classes/URecord.dcu differ diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas new file mode 100644 index 00000000..2ec5439a --- /dev/null +++ b/Game/Code/Classes/URecord.pas @@ -0,0 +1,371 @@ +unit URecord; + +interface +uses Classes, Math, SysUtils, {DXSounds, Wave, }UMusic, UIni, BASS; + +type + TSound = class + BufferNew: TMemoryStream; // buffer for newest sample + BufferArray: array[1..4096] of smallint; // (Signal) newest 4096 samples + BufferLong: array of TMemoryStream; // full buffer + + Num: integer; + n: integer; // length of Signal to analyze +// Spectrum: array[1..8192] of single; // sound buffer from above as FFT +// Spektogram: array[0..100] of TSpekt; // FFT(t) + + // pitch detection + SzczytJest: boolean; // czy jest szczyt + Szczyt: integer; // pozycja szczytu na osi poziomej + TonDokl: real; // ton aktualnego szczytu + Ton: integer; // ton bez ulamka + TonGamy: integer; // ton w gamie. wartosci: 0-11 + Skala: real; // skala FFT + + // procedures + procedure ProcessNewBuffer; + procedure AnalizujBufor; // use to analyze sound from buffers to get new pitch + procedure AnalizujByAutocorrelation; // we call it to analyze sound by checking Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation + end; + + TSoundCardInput = record + Name: string; + end; + + TSoundCard = record + // here can be the soundcard information - whole database from which user will select recording source + Description: string; + Input: array of TSoundCardInput; + InputSeleceted: integer; + + // bass record + BassRecordStream: hStream; + end; + + TRecord = class + SoundCard: array of TSoundCard; + constructor Create; + end; + + smallintarray = array [0..maxInt shr 1-1] of smallInt; + psmallintarray = ^smallintarray; + + // procedures - bass record + function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; + + +var + Sound: array of TSound; + SoundCard: array of TSoundCard; + Poz: integer; + Recording: TRecord; + +implementation +uses UMain, ULog; + +procedure TSound.ProcessNewBuffer; +var + S: integer; + L: integer; + A: integer; +begin + // process BufferArray + S := 0; + L := BufferNew.Size div 2; + if L > n then begin + S := L - n; + L := n; + end; + + // copy to array + for A := L+1 to n do + BufferArray[A-L] := BufferArray[A]; + + BufferNew.Seek(2*S, soBeginning); + BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L); + + // process BufferLong + if Ini.SavePlayback = 1 then begin + BufferNew.Seek(0, soBeginning); + BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); + end; +end; + +procedure TSound.AnalizujBufor; +begin + AnalizujByAutocorrelation; +end; + +procedure TSound.AnalizujByAutocorrelation; +var + T: integer; // tone + F: real; // freq + Wages: array[0..35] of real; // wages + MaxT: integer; // max tone + MaxW: real; // max wage + V: real; // volume + MaxV: real; // max volume + S: integer; // Signal + Threshold: real; // threshold +begin +// Log.LogAnalyze('[Analyze by Autocorrelation]'); + SzczytJest := false; + + // find maximum volume of first 1024 words of signal + MaxV := 0; + for S := 1 to 1024 do begin // 0.5.2: fix. was from 0 to 1023 +// Log.LogDebug('1'); +// Log.LogDebug(IntTostr(S)); + V := Abs(BufferArray[S]) / $10000; +// Log.LogDebug('2'); +// Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray))); + if V > MaxV then MaxV := V; +// Log.LogDebug('3'); +// Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray))); + end; + + + // prepare to analyze + MaxW := 0; + + // analyze all 12 halftones + for T := 0 to 35 do begin // to 11, then 23, now 35 (for Whitney and my high voice) + F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81 + Wages[T] := AnalyzeAutocorrelationFreq(F); + + if Wages[T] > MaxW then begin // this frequency has better wage + MaxW := Wages[T]; + MaxT := T; + end; + end; // for T + + Threshold := 0.1; + case Ini.Threshold of + 0: Threshold := 0.05; + 1: Threshold := 0.1; + 2: Threshold := 0.15; + 3: Threshold := 0.2; + end; + + //Log.LogDebug('Sound -> AnalyzeByAutocorrelation: MaxV='+floattostr(maxv)+', Threshold='+floattostr(threshold)); + if MaxV >= Threshold then begin // found acceptable volume // 0.1 + SzczytJest := true; + TonGamy := MaxT mod 12; + Ton := MaxT mod 12; + end; + +// Log.LogAnalyze('--> Weight: ') +// Log.LogAnalyze('--> Selected: ' + BoolToStr(SzczytJest, true) + +// ', TonGamy: ' + IntToStr(Ton) + +// ', MaxV: ' + FloatToStr(MaxV)); +// Log.LogAnalyze(''); + + +end; + +function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference +var + Count: real; + Src: integer; + Dst: integer; + Move: integer; + Il: integer; // how many counts were done +begin + // we use Signal as source + Count := 0; + Il := 0; + Src := 1; + Move := Round(44100/Freq); + Dst := Src + Move; + + // ver 1 - sample 1 and compare n-times +{ while (Src <= Move) do begin // process by moving Src by one + while (Dst < n) do begin // process up to n (4KB) of Signal + Count := Count + Abs(Signal[Src] - Signal[Dst]) / $10000; + Inc(Dst, Move); + Inc(Il); + end; + + Inc(Src); + Dst := Src + Move; + end;} + + // ver 2 - compare in vertical + while (Dst < n) do begin // process up to n (4KB) of Signal + Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000; + Inc(Src); + Inc(Dst); + Inc(Il); + end; + + Result := 1 - Count / Il; +end; + +function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; +var + L: integer; + S: integer; + PB: pbytearray; + PW: pwordarray; + SI: smallintarray; + PSI: psmallintarray; + I: integer; + Skip: integer; + P1: integer; + P2: integer; + Boost: byte; +begin +// Log.LogDebug('Record -> GetMicrophone: len='+inttstr(len)); + + // set boost + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + end; + + // boost buffer + L := Len div 2; // number of samples + PSI := Buffer; + for S := 0 to L-1 do begin + I := PSI^[S] * Boost; + if I > 32767 then I := 32767; // 0.5.0: limit + if I < -32768 then I := -32768; // 0.5.0: limit + PSI^[S] := I; + end; + + // decode user + P1 := (user and 255) - 1; + P2 := (user div 256) - 1; + +// Log.LogDebug('Record -> GetMicrophone: P1='+inttostr(p1)+', P2='+inttostr(p2)); + + // 2 players USB mic, left channel + if P1 >= 0 then begin + L := Len div 4; // number of samples + PB := Buffer; +// Log.LogDebug('Record -> GetMicrophone -> Sound[P1].BufferNew.Clear'); + Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting + for S := 1 to L do begin + Sound[P1].BufferNew.Write(PB[(S-1)*4], 2); + end; + Sound[P1].ProcessNewBuffer; + end; + + // 2 players USB mic, right channel +// if Ini.Debug = 0 then Skip := 2 +// else Skip := 0; + Skip := 2; + + if P2 >= 0 then begin + L := Len div 4; // number of samples + PB := Buffer; + Sound[P2].BufferNew.Clear; + for S := 1 to L do begin + Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2); + end; + Sound[P2].ProcessNewBuffer; + end; + +// Log.LogDebug('Record -> GetMicrophone -> Finish'); + + Result := true; +end; + +constructor TRecord.Create; +var + SC: integer; // soundcard + SCI: integer; // soundcard input + Descr: string; + InputName: string; + Flags: integer; + No: integer; + function isDuplicate(Desc: String): Boolean; + var + I: Integer; + begin + Result := False; + //Check for Soundcard with same Description + For I := 0 to SC-1 do + begin + if (SoundCard[I].Description = Desc) then + begin + Result := True; + Break; + end; + end; + end; + +// mic: array[0..15] of integer; +begin + // checks for recording devices and puts them into array; + SetLength(SoundCard, 0); + + SC := 0; + Descr := BASS_RecordGetDeviceDescription(SC); + + while (Descr <> '') do begin + + //If there is another SoundCard with the Same ID, Search an available Name + if (IsDuplicate(Descr)) then + begin + No:= 1; //Count of SoundCards with same Name + Repeat + Inc(No) + Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + //Set Description + Descr := Descr + ' (' + InttoStr(No) + ')'; + end; + + SetLength(SoundCard, SC+1); +// Log.LogError('Device #' + IntToStr(SC+1) + ': ' + Descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs +// mic[device] := -1; // default to no change + SCI := 0; + BASS_RecordInit(SC); + Flags := BASS_RecordGetInput(SCI); + InputName := BASS_RecordGetInputName(SCI); +// Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName); + + SetLength(SoundCard[SC].Input, 1); + SoundCard[SC].Input[SCI].Name := InputName; + + // process each input + while (Flags <> -1) do begin + if SCI >= 1 then begin + SetLength(SoundCard[SC].Input, SCI+1); + InputName := BASS_RecordGetInputName(SCI); + SoundCard[SC].Input[SCI].Name := InputName; +// Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName); + end; + +{ if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end;} + + Inc(SCI); + Flags := BASS_RecordGetInput(SCI); + end; + +{ if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device];} + + + BASS_RecordFree; + + Inc(SC); + Descr := BASS_RecordGetDeviceDescription(SC); + end; // while +end; +end. + + diff --git a/Game/Code/Classes/UScores.dcu b/Game/Code/Classes/UScores.dcu new file mode 100644 index 00000000..16454265 Binary files /dev/null and b/Game/Code/Classes/UScores.dcu differ diff --git a/Game/Code/Classes/UScores.pas b/Game/Code/Classes/UScores.pas new file mode 100644 index 00000000..f1243868 --- /dev/null +++ b/Game/Code/Classes/UScores.pas @@ -0,0 +1,144 @@ +unit UScores; + +interface + +uses USongs, SQLiteTable3; + +procedure InitScore(const Filename: string); +procedure ReadScore(var Song: TSong); +procedure WriteScore(var Song: TSong); +procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); + +var +ScoreDB: TSqliteDatabase; +sFilename: string; + +implementation + +uses IniFiles, SysUtils; + +procedure InitScore(const Filename: string); +//var + //TableData: TSqliteTable; +begin + //Open Database + ScoreDB := TSqliteDatabase.Create(Filename); + sFilename := Filename; + + try + //Look for Tables => When not exist Create them + if not ScoreDB.TableExists('US_Scores') then + ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + + if not ScoreDB.TableExists('US_Songs') then + ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL );'); + + finally + //ScoreDB.Free; + end; + +end; + +procedure ReadScore(var Song: TSong); +var + TableData: TSqliteTable; + Dif: Byte; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + try + //Search Song in DB + TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); + //Empty Old Scores + SetLength (Song.Score[0], 0); + SetLength (Song.Score[1], 0); + SetLength (Song.Score[2], 0); + + while not TableData.Eof do//Go through all Entrys + begin//Add one Entry to Array + Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); + if (Dif>=0) AND (Dif<=2) then + begin + SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); + + Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); + Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + end; + TableData.Next; + end; + + except //Im Fehlerfall + for Dif := 0 to 2 do + begin + SetLength(Song.Score[Dif], 1); + Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; + end; + end; + finally + //ScoreDb.Free; + end; +end; + +procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); +var +ID: Integer; +TableData: TSqliteTable; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Song doesn't exist -> Create + begin + ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '");'); + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Could not Create Table + exit; + end; + //Create new Entry + ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); + + //Delete Last Position when there are more than 5 Entrys + if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then + begin + TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); + ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); + end; + + finally + //ScoreDB.Free; + end; +end; + +//Not used with new SQLLite DB System +procedure WriteScore(var Song: TSong); +{var + F: TIniFile; + S: integer; + Lev: integer; + LevS: string; + FileName: string;} +begin + {FileName := Song.Path + ChangeFileExt(Song.FileName, '.sco'); + if (not FileExists(FileName)) or (FileExists(FileName) and DeleteFile(FileName)) then begin + // file has been deleted -> creating new file + F := TIniFile.Create(FileName); + + for Lev := 0 to 2 do begin + case Lev of + 0: LevS := 'Easy'; + 1: LevS := 'Normal'; + 2: LevS := 'Hard'; + end; + + for S := 0 to high(Song.Score[Lev]) do begin + F.WriteString(LevS + IntToStr(S+1), 'Name', Song.Score[Lev, S].Name); + F.WriteInteger(LevS + IntToStr(S+1), 'Score', Song.Score[Lev, S].Score); + + end; // for S + end; // for Lev + F.Free; + end; // if} +end; + +end. diff --git a/Game/Code/Classes/USkins.dcu b/Game/Code/Classes/USkins.dcu new file mode 100644 index 00000000..89ea67c0 Binary files /dev/null and b/Game/Code/Classes/USkins.dcu differ diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas new file mode 100644 index 00000000..6cd4a1db --- /dev/null +++ b/Game/Code/Classes/USkins.pas @@ -0,0 +1,158 @@ +unit USkins; + +interface + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, Classes, SysUtils, ULog, UIni; + +constructor TSkin.Create; +begin + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; + SR2: TSearchRec; + SLen: integer; +begin + if FindFirst('Skins\*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir('Skins\' + SR.Name + '\'); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; + SLen: integer; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + //Log.LogError(SR.Name); + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + for T := 0 to High(SkinTexture) do + if SkinTexture[T].Name = TextureName then Result := SkinPath + SkinTexture[T].FileName; + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/Game/Code/Classes/USongs.dcu b/Game/Code/Classes/USongs.dcu new file mode 100644 index 00000000..e58c47d8 Binary files /dev/null and b/Game/Code/Classes/USongs.dcu differ diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas new file mode 100644 index 00000000..c2532a03 --- /dev/null +++ b/Game/Code/Classes/USongs.pas @@ -0,0 +1,667 @@ +unit USongs; + +interface +uses SysUtils, ULog, UTexture, UCatCovers; + +type + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: string; + Score: integer; + Length: string; + end; + + TSong = record + Path: string; + Folder: string; // for sorting by folder + FileName: string; + + // sorting methods + Category: array of string; // I think I won't need this + Genre: string; + Edition: string; + Language: string; // 0.5.0: new + + Title: string; + Artist: string; + + Text: string; + Creator: string; + + Cover: string; + CoverTex: TTexture; + Mp3: string; + Background: string; + Video: string; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class + Song: array of TSong; // array of songs + Selected: integer; // selected song index + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: string); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: string): string; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +implementation + +uses UPliki, UIni, UFiles; + +procedure TSongs.LoadSongList; +begin + Log.LogStatus('Initializing', 'LoadSongList'); + + // clear + Setlength(Song, 0); + + // browse directories + BrowseDir(SongPath); +// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); +end; + +procedure TSongs.BrowseDir(Dir: string); +var + SR: TSearchRec; // for parsing Songs Directory + SLen: integer; +begin + if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Dir + Sr.Name + '\'); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + if FindFirst(Dir + '*.txt', 0, SR) = 0 then begin +// Log.LogStatus('Parsing file: ' + Dir + SR.Name + '\' + SRD.Name, 'LoadSongList'); + repeat + SLen := Length(Song); + SetLength(Song, SLen + 1); + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos('\', Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then SetLength(Song, SLen) + else begin + // scanning complete, file is good + // if there is no cover then try to find it + if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); +// if Song[SLen].Background = '' then begin +// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); +// end; // no needed here} + + // fix by adding path. no, don't fix it. +// if Song[SLen].Cover <> '' then +// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; + end; + + until FindNext(SR) <> 0; + end; // if FindFirst + FindClose(SR); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Edition < Song[S-1].Edition then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Genre < Song[S-1].Genre then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Title < Song[S-1].Title then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Artist < Song[S-1].Artist then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Folder < Song[S-1].Folder then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Title < Song[S-1].Title then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Artist < Song[S-1].Artist then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if Song[S].Language < Song[S-1].Language then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: string): string; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (SS <> Songs.Song[S].Edition) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (SS <> Songs.Song[S].Genre) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (SS <> Songs.Song[S].Language) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> Songs.Song[S].Title[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Songs.Song[S].Title[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> Songs.Song[S].Artist[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Songs.Song[S].Artist[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (SS <> Songs.Song[S].Folder) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := Songs.Song[S].Title[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := Songs.Song[S].Artist[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].OrderNum = Index then + CatSongs.Song[S].Visible := true + else + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + //Hide Categorys when in Category Hack + for S := low(CatSongs.Song) to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then //Hide all Cats + CatSongs.Song[S].Visible := false + end; + //Hide Categorys when in Category Hack End + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +end. diff --git a/Game/Code/Classes/UTexture.dcu b/Game/Code/Classes/UTexture.dcu new file mode 100644 index 00000000..ec06b7e4 Binary files /dev/null and b/Game/Code/Classes/UTexture.dcu differ diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas new file mode 100644 index 00000000..767d53ec --- /dev/null +++ b/Game/Code/Classes/UTexture.pas @@ -0,0 +1,811 @@ +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes; + +procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; +//procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; +//function gluBuild2DMipmaps (target: GLenum; components, width, height: GLint; +// format, atype: GLenum; data: Pointer): Integer; stdcall; external glu32; +//procedure glCopyTexImage2D(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); stdcall; external opengl32; + + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Nazwa: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + + // for print screens +// PrintScreenTex: GLuint; +// PrintScreenData: array[0..480-1, 0..640-1] of longword; + PrintScreenData: array[0..1024*768-1] of longword; + +// Tekstur: Gluint; + ActTex: GLuint;//integer; + +{ Tekstura: array[1..32] of TTekstura; + Mipmapping: boolean = true;} + + TexOrygW: integer; + TexOrygH: integer; + TexNewW: integer; + TexNewH: integer; +{ RLE: array[1..128*128] of byte; + RLE2: array[1..128*128] of byte;} + + TexFitW: integer; + TexFitH: integer; // new for limit + + TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) + TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) + TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) + TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + +{ Paleta: array[0..255, 1..4] of byte; + Len: integer;} + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + // find texture entry + T := FindTexture(Name); + + if T = -1 then begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that not textures has been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin + // load texture + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + + end; + + if FromCache and Covers.CoverExists(Name) then begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + // load texture + Covers.PrepareData(Name); +{ Covers.Data[0] := 0; + Covers.Data[1] := 0; + Covers.Data[2] := 0; + Covers.Data[3] := 255; + Covers.Data[4] := 255; + Covers.Data[5] := 255;} + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +var + Res: TResourceStream; + TextureB: TBitmap; + TextureJ: TJPEGImage; + + Pet: integer; + Pet2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; + SkipX: integer; +begin + Log.BenchmarkStart(4); + Mipmapping := true; + + if FromRegistry then begin + try + Res := TResourceStream.Create(HInstance, Nazwa, Format); + except + beep; + Exit; + end; + end; + + if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin + + TextureB := TBitmap.Create; + + if Format = 'JPG' then begin + TextureJ := TJPEGImage.Create; + if FromRegistry then TextureJ.LoadFromStream(Res) + else begin + if FileExists(Nazwa) then + TextureJ.LoadFromFile(Nazwa) + else + Exit; + end; + TextureB.Assign(TextureJ); + TextureJ.Free; + end; + if Format = 'BMP' then begin + if FromRegistry then TextureB.LoadFromStream(Res) + else TextureB.LoadFromFile(Nazwa); + end; + + if FromRegistry then Res.Free; + + if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver + Log.LogError('Image ' + Nazwa + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Result.TexNum := -1; + end else begin + + glGenTextures(1, ActTex); + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + + if Typ = 'Plain' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + + // kopiowanie + TextureB.PixelFormat := pf24bit; +{ if (TextureB.PixelFormat = pf8bit) then begin + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD24[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD24[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD24[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + end; + end; + end;} + if (TexOrygW <= Limit) and (TexOrygW <= Limit) then begin + if (TextureB.PixelFormat = pf24bit) then begin + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD24[Pet*TexNewW + Pet2+1, 1] := PPix[Pet2*3+2]; + TextureD24[Pet*TexNewW + Pet2+1, 2] := PPix[Pet2*3+1]; + TextureD24[Pet*TexNewW + Pet2+1, 3] := PPix[Pet2*3]; + end; + end; + end; + end else begin + // limit + TexFitW := 4 * (TexOrygW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrygH; + if (TextureB.PixelFormat = pf24bit) then begin + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD24[Pet*TexFitW + Pet2+1, 1] := PPix[Pet2*3+2]; + TextureD24[Pet*TexFitW + Pet2+1, 2] := PPix[Pet2*3+1]; + TextureD24[Pet*TexFitW + Pet2+1, 3] := PPix[Pet2*3]; + end; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, + Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time + + TexNewW := Limit; + TexNewH := Limit; + TexOrygW := Limit; + TexOrygH := Limit; + end; + + // creating cache mipmap + if CreateCacheMipmap then begin + if (TexOrygW <> TexNewW) or (TexOrygH <> TexNewH) then begin + // texture only uses some of it's space. there's a need for resize to fit full size + // and get best quality + TexFitW := 4 * (TexOrygW div 4); // 0.5.0: fix for bug in gluScaleImage + SkipX := (TexOrygW div 2) mod 2; // 0.5.0: try to center image + + TexFitH := TexOrygH; + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD242[Pet*TexFitW + Pet2+1, 1] := PPix[(Pet2+SkipX)*3+2]; + TextureD242[Pet*TexFitW + Pet2+1, 2] := PPix[(Pet2+SkipX)*3+1]; + TextureD242[Pet*TexFitW + Pet2+1, 3] := PPix[(Pet2+SkipX)*3]; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + + end else begin + // texture fits perfectly + gluScaleImage(GL_RGB, TexOrygW, TexOrygH, GL_UNSIGNED_BYTE, @TextureD24, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + end; + end; + + glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Error > 0 then beep; + end + end; + + if Typ = 'Transparent' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + if Pix = Col then begin + TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 4] := 0; + end else begin + TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + end; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Transparent Range' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + TextureD32[Pet*TexNewW + Pet2+1, 4] := 256 - Pix div 256; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Font' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := 255; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := Pix; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Outline' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Outline 2' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s + // wymiary + TextureB.PixelFormat := pf24bit; + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2*3]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then begin + TextureB.PixelFormat := pf24bit; + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2*3]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Col and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Arrow' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then begin + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Pet2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Pet2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; + TextureD24[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then begin + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Pet2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Pet2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + + + + TextureB.Free; +// Inc(ActTex); +{ Tekst.Tekstura := ActTex; + Tekst.W := TexOrygW; + Tekst.H := TexOrygH; + Tekst.X2 := TexOrygW/TexNewW; + Tekst.Y2 := TexOrygH/TexNewH;} + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := TexOrygW / TexNewW; + Result.TexH := TexOrygH / TexNewH; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Nazwa; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Nazwa + '/' + Typ, 4); + + end; // logerror +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Pet: integer; + Pet2: integer; +begin + for Pet := 0 to TexNewH*4-1 do + for Pet2 := 0 to TexNewW-1 do + d[Pet*TexNewW + Pet2] := 0; + + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + d[(Pet*TexNewW + Pet2)*4] := Paleta[s[Pet*TexOrygW + Pet2], 1]; + d[(Pet*TexNewW + Pet2)*4+1] := Paleta[s[Pet*TexOrygW + Pet2], 2]; + d[(Pet*TexNewW + Pet2)*4+2] := Paleta[s[Pet*TexOrygW + Pet2], 3]; + d[(Pet*TexNewW + Pet2)*4+3] := Paleta[s[Pet*TexOrygW + Pet2], 4]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +begin + glGenTextures(1, Tekstur); + glBindTexture(GL_TEXTURE_2D, Tekstur); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); +end;} + +function TTextureUnit.LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Nazwa, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Nazwa, Format, Typ, Col); // default to SkinReg + +end; + +function TTextureUnit.LoadTexture(Nazwa: string): TTexture; +begin + Result := LoadTexture(false, pchar(Nazwa), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Pet: integer; + Pet2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + +// Inc(ActTex); +{ Tekst.Tekstura := ActTex; + Tekst.W := TexOrygW; + Tekst.H := TexOrygH; + Tekst.X2 := TexOrygW/TexNewW; + Tekst.Y2 := TexOrygH/TexNewH;} + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UThemes.dcu b/Game/Code/Classes/UThemes.dcu new file mode 100644 index 00000000..eb5ec8d4 Binary files /dev/null and b/Game/Code/Classes/UThemes.dcu differ diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas new file mode 100644 index 00000000..29647db6 --- /dev/null +++ b/Game/Code/Classes/UThemes.pas @@ -0,0 +1,1837 @@ +unit UThemes; + +interface + +uses IniFiles, SysUtils, Classes; + +type + TRGB = record + R: single; + G: single; + B: single; + end; + + {TSkin = record + GrayLeft: string; + GrayMid: string; + GrayRight: string; + + NoteBGLeft: string; + NoteBGMid: string; + NoteBGRight: string; + + NoteStar: string; + + Ball: string; + + + + //SingBar Mod + SingBarBack: string; + SingBarBar: string; + SingBarFront: string; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + SingLineBonusBack: string; + //PhrasenBonus - Line Bonus Mod + + + + WelcomeBG: string; + + Background: string; + ScoreBG: string; + MainStart: string; + MainEditor: string; + MainOptions: string; + MainExit: string; + MainBar: string; + Cursor: string; + + SongFade: string; + SongCover: string; + SongSelection: string; + + SelectSong: string; + Button: string; + Bar: string; + P: string; + Arrow: string; + Arrow2: string; + ButtonF: string; + Star: string; + Line: string; + +// ThemePath: string; + SkinReg: boolean; + SkinName: string; + SkinPath: string; + SkinColor: integer; + 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: string; + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + end; + AThemeStatic = array of TThemeStatic; + + TThemeText = record + X: integer; + Y: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Font: integer; + Size: integer; + Align: integer; + Text: string; + end; + AThemeText = array of TThemeText; + + TThemeButton = record + Text: AThemeText; + X: integer; + Y: integer; + 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: string; + //Reflection Mod + Reflection: Boolean; + end; + + 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; + 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; + + TThemeBasic = class + Background: TThemeBackground; + Text: AThemeText; + Static: AThemeStatic; + end; + + TThemeLoading = class(TThemeBasic) + end; + + TThemeMain = class(TThemeBasic) + ButtonSolo: TThemeButton; +// ButtonMulti: TThemeButton; + ButtonEditor: TThemeButton; + ButtonOptions: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextDescriptionLong: TThemeText; + Description: array[0..4] of string; + DescriptionLong: array[0..4] 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; + + //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 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) + StaticP1: TThemeStatic; + StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG + TextP1: TThemeText; + TextP1Score: TThemeText; + + + 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; + end; + + TThemeScore = class(TThemeBasic) + TextArtist: TThemeText; + TextTitle: TThemeText; + + PlayerStatic: array[1..6] of AThemeStatic; + + 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; + + 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; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + Description: array[0..6] 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; + //SelectTwoPlayerMode: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsLyrics = class(TThemeBasic) + SelectLyricsFont: TThemeSelect; + SelectLyricsEffect: TThemeSelect; + SelectSolmization: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsThemes = class(TThemeBasic) + SelectTheme: TThemeSelectSlide; + SelectSkin: TThemeSelectSlide; + SelectColor: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsRecord = class(TThemeBasic) + SelectSlideCard: TThemeSelectSlide; + SelectSlideInput: TThemeSelectSlide; + SelectSlideChannelL: TThemeSelectSlide; + SelectSlideChannelR: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + //ScreenSong Menue + TThemeSongMenu = class(TThemeBasic) + Button1: TThemeButton; + Button2: TThemeButton; + Button3: TThemeButton; + Button4: TThemeButton; + + SelectSlide3: TThemeSelectSlide; + + TextMenu: TThemeText; + 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; + StaticTeam1: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam3: TThemeStatic; + + ButtonNext: TThemeButton; + end; + + TThemePartyScore = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam3: TThemeStatic; + + TextWinner: TThemeText; + end; + + TThemePartyWin = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam3: 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; + + TTheme = class + {$IFDEF THEMESAVE} + ThemeIni: TIniFile; + {$ELSE} + ThemeIni: TMemIniFile; + {$ENDIF} + + 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; + //Menu + SongMenu: TThemeSongMenu; + //Party Screens: + PartyNewRound: TThemePartyNewRound; + PartyScore: TThemePartyScore; + PartyWin: TThemePartyWin; + PartyOptions: TThemePartyOptions; + PartyPlayer: TThemePartyPlayer; + + 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); + 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 +{$IFDEF TRANSLATE} + ULanguage, +{$ENDIF} +USkins, UIni; + +constructor TTheme.Create(FileName: string); +begin + Create(FileName, 0); +end; + +constructor TTheme.Create(FileName: string; Color: integer); +begin + 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; + + SongMenu := TThemeSongMenu.Create; + //Party Screens + PartyNewRound := TThemePartyNewRound.Create; + PartyWin := TThemePartyWin.Create; + PartyScore := TThemePartyScore.Create; + PartyOptions := TThemePartyOptions.Create; + PartyPlayer := TThemePartyPlayer.Create; + + LoadTheme(FileName, Color); + + + {Skin.GrayLeft := 'Left Gray.bmp'; + Skin.GrayMid := 'Mid Gray.bmp'; + Skin.GrayRight := 'Right Gray.bmp'; + + Skin.NoteBGLeft := 'Note BG Left.bmp'; + Skin.NoteBGMid := 'Note BG Mid.bmp'; + Skin.NoteBGRight := 'Note BG Right.bmp'; + + Skin.NoteStar := 'Note Star.jpg'; + + + + //SingBar Mod + Skin.SingBarBack := 'Sing Bar Back.jpg'; + Skin.SingBarBar := 'Sing Bar Bar.jpg'; + Skin.SingBarFront := 'Sing Bar Front.jpg'; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Skin.SingLineBonusBack := 'Line Bonus PopUp.jpg'; + + + + +{ Skin.WelcomeBG := SkinPath + 'Welcome BG.jpg'; +// Skin.Background := SkinPath + 'Background.jpg'; + Skin.ScoreBG := SkinPath + 'Score BG.jpg'; +// Skin.GameStart := SkinPath + 'Game Start.jpg'; +// Skin.Editor := SkinPath + 'Editor.jpg'; +// Skin.Options := SkinPath + 'Options.jpg'; +// Skin.Exit := SkinPath + 'Exit.jpg'; + + Skin.MainStart := SkinPath + 'Main Solo.jpg'; + Skin.MainEditor := SkinPath + 'Main Multi.jpg'; + Skin.MainOptions := SkinPath + 'Main Options.jpg'; + Skin.MainExit := SkinPath + 'Main Exit.jpg'; + Skin.MainBar := SkinPath + 'Main Bar.jpg'; + Skin.Cursor := SkinPath + 'Main Cursor.jpg'; + + Skin.SongFade := SkinPath + 'Song Fade.jpg';}{ + Skin.SongCover := 'Song Cover.jpg'; + {Skin.SongSelection := SkinPath + 'Song Selection.jpg'; + + Skin.SelectSong := SkinPath + 'Select Song.jpg';}{ +// Skin.Button := SkinPath + 'MusicWheelItem song.jpg'; + Skin.Bar := 'Bar.jpg'; +{ Skin.P := SkinPath + 'P.jpg'; + Skin.Arrow := SkinPath + 'Arrow.jpg'; + Skin.Arrow2 := SkinPath + 'Arrow 2.jpg';}{ + Skin.ButtonF := 'Button.jpg'; + Skin.Ball := 'Ball3.bmp'; +{ Skin.Star := SkinPath + 'Star.bmp'; + Skin.Line := SkinPath + 'Line.jpg';} +end; + + +function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; +var + I: integer; + Path: string; +begin + Result := false; + 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'); + + // Main + ThemeLoadBasic(Main, 'Main'); + + ThemeLoadText(Main.TextDescription, 'MainTextDescription'); + ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); + ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo'); + ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor'); + ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions'); + ThemeLoadButton(Main.ButtonExit, 'MainButtonExit'); + + //Score Text Translation Start + + {$IFDEF TRANSLATE} + Main.Description[0] := Language.Translate('SING_SING'); + Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); + Main.Description[1] := Language.Translate('SING_EDITOR'); + Main.DescriptionLong[1] := Language.Translate('SING_EDITOR_DESC'); + Main.Description[2] := Language.Translate('SING_GAME_OPTIONS'); + Main.DescriptionLong[2] := Language.Translate('SING_GAME_OPTIONS_DESC'); + Main.Description[3] := Language.Translate('SING_EXIT'); + Main.DescriptionLong[3] := Language.Translate('SING_EXIT_DESC'); + {$ENDIF} + + //Score 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'); + + //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', 400); + Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 100); + Song.Cover.Z := ThemeIni.ReadInteger('SongCover', 'Z', 250); + Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 200); + Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); + Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 5); + 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', 650); + Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 430); + 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); + + //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'); + + //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; + //Load Equalizer Pos and Size from Theme Mod End + + // Sing + ThemeLoadBasic(Sing, 'Sing'); + + ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); + + + //ScoreBG Mod + ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');//ScoreBG + //end ScoreBG Mod + + + ThemeLoadText(Sing.TextP1, 'SingP1Text'); + ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); + + ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); + + + + //ScoreBG Mod + ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + //end ScoreBG Mod + + + + ThemeLoadText(Sing.TextP2R, 'SingP2RText'); + ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); + + + //ScoreBG Mod + ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + //end ScoreBG Mod + + + + ThemeLoadText(Sing.TextP2M, 'SingP2MText'); + ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); + + + //ScoreBG Mod + ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + //end ScoreBG Mod + + + + ThemeLoadText(Sing.TextP3R, 'SingP3RText'); + ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); + + // Score + ThemeLoadBasic(Score, 'Score'); + + ThemeLoadText(Score.TextArtist, 'ScoreTextArtist'); + ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); + + for I := 1 to 6 do begin + ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); + + 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)); + 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.ButtonExit, 'OptionsButtonExit'); + + {$IFDEF TRANSLATE} + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); + Options.Description[6] := Language.Translate('SING_OPTIONS_EXIT'); + {$ENDIF} + + 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'); + //ThemeLoadSelect(OptionsSound.SelectTwoPlayerMode, 'OptionsSoundSelectTwoPlayerMode'); + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + 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.SelectSlideChannelL, 'OptionsRecordSelectSlideChannelL'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); + ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); + + //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'); + + //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'); + + ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); + ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); + ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); + + ThemeLoadButton (PartyNewRound.ButtonNext, 'PartyNewRoundButtonNext'); + + //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.StaticTeam2, 'PartyScoreStaticTeam2'); + ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); + + 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.StaticTeam2, 'PartyWinStaticTeam2'); + ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); + + 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');} + 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'); +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 + DecimalSeparator := '.'; + ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 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); + + {$IFDEF TRANSLATE} + ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + {$ELSE} + ThemeText.Text := ThemeIni.ReadString(Name, 'Text', ''); + {$ENDIF} + + ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); + + 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; + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + + 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 := ThemeIni.ReadString(Name, 'Type', ''); + 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); + + DecimalSeparator := ','; +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; + +procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string); +var + C: integer; + TLen: integer; + T: integer; +begin + DecimalSeparator := '.'; + ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); + ThemeButton.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeButton.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeButton.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeButton.H := ThemeIni.ReadInteger(Name, 'H', 0); + + ThemeButton.Typ := ThemeIni.ReadString(Name, 'Type', ''); + + //Reflection Mod + ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + + 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; + + 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)); + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + {$IFDEF TRANSLATE} + ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + {$ELSE} + ThemeSelect.Text := ThemeIni.ReadString(Name, 'Text', ''); + {$ENDIF} + + 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); + + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + {$IFDEF TRANSLATE} + ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + {$ELSE} + ThemeSelectS.Text := ThemeIni.ReadString(Name, 'Text', ''); + {$ENDIF} + + 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.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); + + + 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); + + + DecimalSeparator := ','; +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; + + // pink +// Col := clRed; +// Color[C].ColR := (32 + Col and $FF) / (255 + 32); +// Color[C].ColG := (32 + Col div 256 and $FF) / (255 + 32); +// Color[C].ColB := (32 + Col div (256*256) and $FF) / (255 + 32); + + // purple +// Color[C].ColR := 220/255; +// Color[C].ColG := 95/255; +// Color[C].ColB := 220/255;} + +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'); + ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); + + + + //ScoreBG Mod + ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); + //end ScoreBG Mod + + + + ThemeSaveText(Sing.TextP1, 'SingP1Text'); + ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); + + ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); + + + + //ScoreBG Mod + ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + //end ScoreBG Mod + + + + ThemeSaveText(Sing.TextP2R, 'SingP2RText'); + ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic'); + + + + //ScoreBG Mod + ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + //end ScoreBG Mod + + + + + ThemeSaveText(Sing.TextP2M, 'SingP2MText'); + ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); + + + + //ScoreBG Mod + ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + //end ScoreBG Mod + + + + + ThemeSaveText(Sing.TextP3R, 'SingP3RText'); + 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 + DecimalSeparator := '.'; + 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', 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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', 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)); + + DecimalSeparator := ','; +end; + + +end. diff --git a/Game/Code/Classes/UTime.dcu b/Game/Code/Classes/UTime.dcu new file mode 100644 index 00000000..f69b60f7 Binary files /dev/null and b/Game/Code/Classes/UTime.dcu differ diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas new file mode 100644 index 00000000..29e972ae --- /dev/null +++ b/Game/Code/Classes/UTime.pas @@ -0,0 +1,81 @@ +unit UTime; + +interface + +type + TTime = class + constructor Create; + function GetTime: real; + end; + +procedure CountSkipTimeSet; +procedure CountSkipTime; +procedure CountMidTime; +procedure TimeSleep(ms: real); + +var + USTime: TTime; + + TimeFreq: int64; + TimeNew: int64; + TimeOld: int64; + TimeSkip: real; + TimeMid: real; + TimeMidTemp: int64; + +implementation + +uses Windows; + +constructor TTime.Create; +begin + CountSkipTimeSet; +end; + +procedure CountSkipTimeSet; +begin + QueryPerformanceFrequency(TimeFreq); + QueryPerformanceCounter(TimeNew); +end; + +procedure CountSkipTime; +begin + TimeOld := TimeNew; + QueryPerformanceCounter(TimeNew); + TimeSkip := (TimeNew-TimeOld)/TimeFreq; +end; + +procedure CountMidTime; +begin + QueryPerformanceCounter(TimeMidTemp); + TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; +end; + +procedure TimeSleep(ms: real); +var + TimeStart: int64; + TimeHalf: int64; + Time: real; + Stop: boolean; +begin + QueryPerformanceCounter(TimeStart); + + Stop := false; + while (not Stop) do begin + QueryPerformanceCounter(TimeHalf); + Time := 1000 * (TimeHalf-TimeStart)/TimeFreq; + if Time > ms then Stop := true; + end; + +end; + +function TTime.GetTime: real; +var + TimeTemp: int64; +begin + QueryPerformanceCounter(TimeTemp); + Result := TimeTemp/TimeFreq; +end; + + +end. -- cgit v1.2.3 From 947647a5b38bf5b389e1f8b1f06308f564748fb8 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 21 Mar 2007 19:34:36 +0000 Subject: =?UTF-8?q?Datei=20/=20Ordner=20gel=C3=B6scht?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@4 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.dcu | Bin 8556 -> 0 bytes Game/Code/Classes/UCatCovers.dcu | Bin 4945 -> 0 bytes Game/Code/Classes/UCovers.dcu | Bin 6055 -> 0 bytes Game/Code/Classes/UDLLManager.dcu | Bin 6021 -> 0 bytes Game/Code/Classes/UDraw.dcu | Bin 41304 -> 0 bytes Game/Code/Classes/UFiles.dcu | Bin 4673 -> 0 bytes Game/Code/Classes/UGraphic.dcu | Bin 18647 -> 0 bytes Game/Code/Classes/UGraphicClasses.dcu | Bin 341 -> 0 bytes Game/Code/Classes/UIni.dcu | Bin 22355 -> 0 bytes Game/Code/Classes/UJoystick.dcu | Bin 2268 -> 0 bytes Game/Code/Classes/ULCD.dcu | Bin 5497 -> 0 bytes Game/Code/Classes/ULCD.~pas | 287 ---------------------------------- Game/Code/Classes/ULanguage.dcu | Bin 6519 -> 0 bytes Game/Code/Classes/ULight.dcu | Bin 2389 -> 0 bytes Game/Code/Classes/ULog.dcu | Bin 6217 -> 0 bytes Game/Code/Classes/ULyrics.dcu | Bin 9029 -> 0 bytes Game/Code/Classes/UMain.dcu | Bin 11501 -> 0 bytes Game/Code/Classes/UMusic.dcu | Bin 15179 -> 0 bytes Game/Code/Classes/UParty.dcu | Bin 4129 -> 0 bytes Game/Code/Classes/UPliki.dcu | Bin 19679 -> 0 bytes Game/Code/Classes/URecord.dcu | Bin 6913 -> 0 bytes Game/Code/Classes/UScores.dcu | Bin 4811 -> 0 bytes Game/Code/Classes/USkins.dcu | Bin 5747 -> 0 bytes Game/Code/Classes/USongs.dcu | Bin 13980 -> 0 bytes Game/Code/Classes/UTexture.dcu | Bin 19192 -> 0 bytes Game/Code/Classes/UThemes.dcu | Bin 59165 -> 0 bytes Game/Code/Classes/UTime.dcu | Bin 2083 -> 0 bytes 27 files changed, 287 deletions(-) delete mode 100644 Game/Code/Classes/TextGL.dcu delete mode 100644 Game/Code/Classes/UCatCovers.dcu delete mode 100644 Game/Code/Classes/UCovers.dcu delete mode 100644 Game/Code/Classes/UDLLManager.dcu delete mode 100644 Game/Code/Classes/UDraw.dcu delete mode 100644 Game/Code/Classes/UFiles.dcu delete mode 100644 Game/Code/Classes/UGraphic.dcu delete mode 100644 Game/Code/Classes/UGraphicClasses.dcu delete mode 100644 Game/Code/Classes/UIni.dcu delete mode 100644 Game/Code/Classes/UJoystick.dcu delete mode 100644 Game/Code/Classes/ULCD.dcu delete mode 100644 Game/Code/Classes/ULCD.~pas delete mode 100644 Game/Code/Classes/ULanguage.dcu delete mode 100644 Game/Code/Classes/ULight.dcu delete mode 100644 Game/Code/Classes/ULog.dcu delete mode 100644 Game/Code/Classes/ULyrics.dcu delete mode 100644 Game/Code/Classes/UMain.dcu delete mode 100644 Game/Code/Classes/UMusic.dcu delete mode 100644 Game/Code/Classes/UParty.dcu delete mode 100644 Game/Code/Classes/UPliki.dcu delete mode 100644 Game/Code/Classes/URecord.dcu delete mode 100644 Game/Code/Classes/UScores.dcu delete mode 100644 Game/Code/Classes/USkins.dcu delete mode 100644 Game/Code/Classes/USongs.dcu delete mode 100644 Game/Code/Classes/UTexture.dcu delete mode 100644 Game/Code/Classes/UThemes.dcu delete mode 100644 Game/Code/Classes/UTime.dcu (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.dcu b/Game/Code/Classes/TextGL.dcu deleted file mode 100644 index 772d09c1..00000000 Binary files a/Game/Code/Classes/TextGL.dcu and /dev/null differ diff --git a/Game/Code/Classes/UCatCovers.dcu b/Game/Code/Classes/UCatCovers.dcu deleted file mode 100644 index 2ff7a7d9..00000000 Binary files a/Game/Code/Classes/UCatCovers.dcu and /dev/null differ diff --git a/Game/Code/Classes/UCovers.dcu b/Game/Code/Classes/UCovers.dcu deleted file mode 100644 index ca99fc7c..00000000 Binary files a/Game/Code/Classes/UCovers.dcu and /dev/null differ diff --git a/Game/Code/Classes/UDLLManager.dcu b/Game/Code/Classes/UDLLManager.dcu deleted file mode 100644 index 3ba97949..00000000 Binary files a/Game/Code/Classes/UDLLManager.dcu and /dev/null differ diff --git a/Game/Code/Classes/UDraw.dcu b/Game/Code/Classes/UDraw.dcu deleted file mode 100644 index a3fcecc9..00000000 Binary files a/Game/Code/Classes/UDraw.dcu and /dev/null differ diff --git a/Game/Code/Classes/UFiles.dcu b/Game/Code/Classes/UFiles.dcu deleted file mode 100644 index 9ed45d8f..00000000 Binary files a/Game/Code/Classes/UFiles.dcu and /dev/null differ diff --git a/Game/Code/Classes/UGraphic.dcu b/Game/Code/Classes/UGraphic.dcu deleted file mode 100644 index c264b16b..00000000 Binary files a/Game/Code/Classes/UGraphic.dcu and /dev/null differ diff --git a/Game/Code/Classes/UGraphicClasses.dcu b/Game/Code/Classes/UGraphicClasses.dcu deleted file mode 100644 index 58d003b0..00000000 Binary files a/Game/Code/Classes/UGraphicClasses.dcu and /dev/null differ diff --git a/Game/Code/Classes/UIni.dcu b/Game/Code/Classes/UIni.dcu deleted file mode 100644 index e891d36c..00000000 Binary files a/Game/Code/Classes/UIni.dcu and /dev/null differ diff --git a/Game/Code/Classes/UJoystick.dcu b/Game/Code/Classes/UJoystick.dcu deleted file mode 100644 index 62cde484..00000000 Binary files a/Game/Code/Classes/UJoystick.dcu and /dev/null differ diff --git a/Game/Code/Classes/ULCD.dcu b/Game/Code/Classes/ULCD.dcu deleted file mode 100644 index 8098a187..00000000 Binary files a/Game/Code/Classes/ULCD.dcu and /dev/null differ diff --git a/Game/Code/Classes/ULCD.~pas b/Game/Code/Classes/ULCD.~pas deleted file mode 100644 index a127c689..00000000 --- a/Game/Code/Classes/ULCD.~pas +++ /dev/null @@ -1,287 +0,0 @@ -unit ULCD; - -interface - -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, zlportio, UTime; - -procedure TLCD.WriteCommand(B: Byte); -// Wysylanie komend sterujacych -begin - 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); - - TimeSleep(0.1); - - 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 - TimeSleep(0.1); -end; - -procedure TLCD.WriteData(B: Byte); -// Wysylanie danych -begin - 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); - - TimeSleep(0.1); - - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, (B * 16) and $F0); - zlioportwrite(Control, 0, $07); - end; - - TimeSleep(0.1); - Inc(Position); -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 -// -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/ULanguage.dcu b/Game/Code/Classes/ULanguage.dcu deleted file mode 100644 index 2d5c3596..00000000 Binary files a/Game/Code/Classes/ULanguage.dcu and /dev/null differ diff --git a/Game/Code/Classes/ULight.dcu b/Game/Code/Classes/ULight.dcu deleted file mode 100644 index 10ba61bc..00000000 Binary files a/Game/Code/Classes/ULight.dcu and /dev/null differ diff --git a/Game/Code/Classes/ULog.dcu b/Game/Code/Classes/ULog.dcu deleted file mode 100644 index 1794325d..00000000 Binary files a/Game/Code/Classes/ULog.dcu and /dev/null differ diff --git a/Game/Code/Classes/ULyrics.dcu b/Game/Code/Classes/ULyrics.dcu deleted file mode 100644 index 3867c263..00000000 Binary files a/Game/Code/Classes/ULyrics.dcu and /dev/null differ diff --git a/Game/Code/Classes/UMain.dcu b/Game/Code/Classes/UMain.dcu deleted file mode 100644 index 3a2edf09..00000000 Binary files a/Game/Code/Classes/UMain.dcu and /dev/null differ diff --git a/Game/Code/Classes/UMusic.dcu b/Game/Code/Classes/UMusic.dcu deleted file mode 100644 index f3116f8b..00000000 Binary files a/Game/Code/Classes/UMusic.dcu and /dev/null differ diff --git a/Game/Code/Classes/UParty.dcu b/Game/Code/Classes/UParty.dcu deleted file mode 100644 index e3e1a901..00000000 Binary files a/Game/Code/Classes/UParty.dcu and /dev/null differ diff --git a/Game/Code/Classes/UPliki.dcu b/Game/Code/Classes/UPliki.dcu deleted file mode 100644 index 1798b6f8..00000000 Binary files a/Game/Code/Classes/UPliki.dcu and /dev/null differ diff --git a/Game/Code/Classes/URecord.dcu b/Game/Code/Classes/URecord.dcu deleted file mode 100644 index d28aa4b1..00000000 Binary files a/Game/Code/Classes/URecord.dcu and /dev/null differ diff --git a/Game/Code/Classes/UScores.dcu b/Game/Code/Classes/UScores.dcu deleted file mode 100644 index 16454265..00000000 Binary files a/Game/Code/Classes/UScores.dcu and /dev/null differ diff --git a/Game/Code/Classes/USkins.dcu b/Game/Code/Classes/USkins.dcu deleted file mode 100644 index 89ea67c0..00000000 Binary files a/Game/Code/Classes/USkins.dcu and /dev/null differ diff --git a/Game/Code/Classes/USongs.dcu b/Game/Code/Classes/USongs.dcu deleted file mode 100644 index e58c47d8..00000000 Binary files a/Game/Code/Classes/USongs.dcu and /dev/null differ diff --git a/Game/Code/Classes/UTexture.dcu b/Game/Code/Classes/UTexture.dcu deleted file mode 100644 index ec06b7e4..00000000 Binary files a/Game/Code/Classes/UTexture.dcu and /dev/null differ diff --git a/Game/Code/Classes/UThemes.dcu b/Game/Code/Classes/UThemes.dcu deleted file mode 100644 index eb5ec8d4..00000000 Binary files a/Game/Code/Classes/UThemes.dcu and /dev/null differ diff --git a/Game/Code/Classes/UTime.dcu b/Game/Code/Classes/UTime.dcu deleted file mode 100644 index f69b60f7..00000000 Binary files a/Game/Code/Classes/UTime.dcu and /dev/null differ -- cgit v1.2.3 From a48be5b4dd13db5cbc2cce4932508e61ff354340 Mon Sep 17 00:00:00 2001 From: mogguh Date: Wed, 21 Mar 2007 21:35:49 +0000 Subject: Golden notes are implemented from now on. So "golden notes" twinkle, and perfect sung notes twinkle too. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@12 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 22 +-- Game/Code/Classes/UGraphicClasses.pas | 266 ++++++++++++++++++++++++++++++++++ 2 files changed, 279 insertions(+), 9 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index e9433790..4e4691ad 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,7 +1,7 @@ unit UDraw; interface -uses UThemes, ModiSDK; +uses UThemes, ModiSDK, UGraphicClasses; procedure SingDraw; procedure SingModiDraw (PlayerInfo: TPlayerInfo); @@ -200,6 +200,8 @@ var Pet: integer; TempR: real; R,G,B: real; + + GoldenStarPos : real; begin glColor3f(1, 1, 1); glEnable(GL_TEXTURE_2D); @@ -214,11 +216,9 @@ begin // Golden Note Patch case Wartosc of 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 0.3, 0.85); + 2: glColor4f(1, 1, 1, 0.85); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); end; // case - - // lewa czesc - left part Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; @@ -232,6 +232,11 @@ begin glTexCoord2f(7/8, 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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; @@ -256,12 +261,11 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // Golden Star Patch - //case Wartosc of - // 2: SingGoldenStar(Rec.Left, Rec.Top, 1, StarfrG); - //end; // case - + if Wartosc = 2 then + begin + GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); + end; end; // if not FreeStyle end; // with diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index abb59e4b..d66bd142 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -2,6 +2,272 @@ unit UGraphicClasses; interface +type + TParticle = Class + X, Y : Real; //Position + Frame : Byte; //act. Frame + Tex : Cardinal; //Tex num from Textur Manager + Live : Byte; //How many Cycles before Kill + RecIndex : Integer; //To which rectangle belongs this particle + + Constructor Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; RecArrayIndex : Integer); + procedure Draw; + end; + + RectanglePositions = Record + xTop, yTop, xBottom, yBottom : Real; + TotalStarCount : Integer; + CurrentStarCount : Integer; + end; + + PerfectNotePositions = Record + xPos, yPos : Real; + end; + + TEffectManager = Class + Particle : array of TParticle; + LastTime : Cardinal; + RecArray : Array of RectanglePositions; + PerfNoteArray : Array of PerfectNotePositions; + + constructor Create; + procedure Draw; + function Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer): Cardinal; + procedure SpawnRec(); + procedure Kill(index: Cardinal); + procedure KillAll(); + procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); + procedure SpawnNotePerfect(xPos,yPos : real); + procedure SavePerfectNotePos(Xtop, Ytop: Real); + end; + +var GoldenRec : TEffectManager; + implementation +uses sysutils, Windows,OpenGl12, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; + +//TParticle +Constructor TParticle.Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; RecArrayIndex : Integer); +begin + X := cX; + Y := cY; + Tex := cTex; + Live := cLive; + Frame:= cFrame; + RecIndex := RecArrayIndex; +end; + + +procedure TParticle.Draw; +var + W, H: real; + Alpha : real; +begin + W := 20; + H := 20; + + Alpha := (-cos((Frame+1)*2*pi/16)+1); //Fade Eyecandy + + glColor4f(0.99, 1, 0.6, Alpha); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); + + begin + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W, Y-H); + glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W, Y+H); + glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W, Y+H); + glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W, Y-H); + glEnd; + end; + glcolor4f(1,1,1,1); +end; + + + +constructor TEffectManager.Create; +begin + LastTime := GetTickCount; +end; + + +procedure TEffectManager.Draw; +var + I: Integer; + CurrentTime: Cardinal; +const + DelayBetweenFrames : Integer = 100; +begin + + CurrentTime := GetTickCount; + //Manage particle life + if (CurrentTime > (LastTime + DelayBetweenFrames)) then + begin + LastTime := CurrentTime; + for I := 0 to high(Particle) do + begin + Particle[I].Frame := (Particle[I].Frame + 1 ) mod 16; + //Live = 0 => Live forever + if (Particle[I].Live > 0) then + begin + Dec(Particle[I].Live); + end; + end; + 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; + + +function TEffectManager.Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer): Cardinal; +begin + Result := Length(Particle); + SetLength(Particle, (Result + 1)); + Particle[Result] := TParticle.Create(X, Y, Tex, Live, StartFrame, RecArrayIndex); +end; + + +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(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, P); + inc(RecArray[P].CurrentStarCount); + end; + end; + draw; +end; + + +procedure TEffectManager.SpawnNotePerfect(xPos,yPos : real); +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 2 do + begin + Xkatze := RandomRange(ceil(xPos) - 5 , ceil(xPos) + 10); + Ykatze := RandomRange(ceil(yPos) - 5 , ceil(yPos) + 10); + RandomFrame := RandomRange(0,14); + Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1); + end; + draw; +end; + + +procedure TEffectManager.Kill(Index: Cardinal); +var + LastParticleIndex : Cardinal; +begin +// We put the last element of the array on the place where our element_to_delete resides and then we shorten the array - cool, hu? :P + +LastParticleIndex := high(Particle); +if not(LastParticleIndex = -1) then + begin + Try + Finally + if not(Particle[Index].RecIndex = -1) then + dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); + Particle[Index].Destroy; + Particle[Index] := Particle[LastParticleIndex]; + SetLength(Particle, LastParticleIndex); + end; + end; +end; + +procedure TEffectManager.KillAll(); +begin +//It's the kill all kennies rotuine + while Length(Particle) > 0 do + Kill(0); + SetLength(RecArray,0); + SetLength(PerfNoteArray,0); +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))) 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; +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 + if ((ceil(PerfNoteArray[P].xPos) = ceil(Xtop)) and (ceil(PerfNoteArray[P].yPos) = ceil(Ytop))) 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(PerfNoteArray); + SetLength(PerfNoteArray, NewIndex + 1); + PerfNoteArray[NewIndex].xPos := Xtop; + PerfNoteArray[NewIndex].yPos := Ytop; + + 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, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1); + end; + +end; end. + -- cgit v1.2.3 From c33620b856f5106ba95638106c5a55ff88e5290c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 22 Mar 2007 19:59:00 +0000 Subject: Fixed Bug: No BG in Party Mode and little Code clean up git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@16 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 1 + Game/Code/Classes/UIni.pas | 4 ++-- Game/Code/Classes/ULanguage.pas | 18 ++++++++++-------- Game/Code/Classes/UThemes.pas | 9 +++++---- 4 files changed, 18 insertions(+), 14 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 4e4691ad..31291788 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -71,6 +71,7 @@ begin if ScreenSing.Tex_Background.TexNum >= 1 then begin glClearColor (1, 1, 1, 1); + glColor4f (1, 1, 1, 1); if (Ini.MovieSize = 0) then //HalfSize BG begin diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index beadabb6..a17ba52d 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -483,11 +483,11 @@ begin for Pet := 0 to High(IJoypad) do if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - // SoundCard + {// SoundCard for I := 0 to 7 do begin Ini.SoundCard[I, 1] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'L', Ini.SoundCard[I, 1]); Ini.SoundCard[I, 2] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'R', Ini.SoundCard[I, 2]); - end; + end; } // LCD Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index bc3793e3..afdac87c 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -14,7 +14,7 @@ type end; TLanguage = class - private + public Entry: array of TLanguageEntry; //Entrys of Chosen Language SEntry: array of TLanguageEntry; //Entrys of Standard Language CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version @@ -68,6 +68,8 @@ begin SEntry[J] := Entry[J]; SetLength(Entry, 0); + + Break; end; if (I = high(List)) then @@ -139,6 +141,9 @@ var E: integer; // entry begin Result := Text; + Text := Uppercase(Result); + + Log.LogError('Text: "' + Text + '" L: ' + InttoStr(Length(Entry))); //Const Mod for E := 0 to high(CEntry) do @@ -158,14 +163,11 @@ begin //Standard Language (If a Language File is Incomplete) //Then use Standard Language - if Text = Result then + for E := low(SEntry) to high(SEntry) do + if Text = SEntry[E].ID then begin - for E := low(SEntry) to high(SEntry) do - if Text = SEntry[E].ID then - begin - Result := SEntry[E].Text; - exit; - end; + Result := SEntry[E].Text; + Break; end; //Standard Language END end; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 29647db6..c4b83d8b 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -2,7 +2,11 @@ unit UThemes; interface -uses IniFiles, SysUtils, Classes; +uses +{$IFDEF TRANSLATE} + ULanguage, +{$ENDIF} +IniFiles, SysUtils, Classes; type TRGB = record @@ -576,9 +580,6 @@ var implementation uses -{$IFDEF TRANSLATE} - ULanguage, -{$ENDIF} USkins, UIni; constructor TTheme.Create(FileName: string); -- cgit v1.2.3 From 07174bc088f8b14203a1417e7ffe0cc8a8be5e73 Mon Sep 17 00:00:00 2001 From: mogguh Date: Thu, 22 Mar 2007 22:10:33 +0000 Subject: Added new texture for perfect sung note (formerly NoteStar), now named NotePerfectStar (view skin: W&C.ini). NoteStar is now used for golden notes. There's also a difference in drawing both, PerfectNoteStar is bigger, and drawn in white - whereas GoldenNotes are smaller and yellow. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@17 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 15 +++++++----- Game/Code/Classes/UGraphic.pas | 3 +++ Game/Code/Classes/UGraphicClasses.pas | 43 +++++++++++++++++++++++------------ 3 files changed, 40 insertions(+), 21 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 31291788..2e742172 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -12,9 +12,10 @@ procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +{ for no use since we have UGraphicClasses procedure SingDrawStar(X, Y, A: real); procedure SingGoldenStar(X, Y, A: real); - +} // The Singbar procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); @@ -381,8 +382,8 @@ var //inc(Starfr); //Starfr := Starfr mod 128; - - SingDrawStar(Rec.Left+2, Rec.Top+4, A); + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + { SingDrawStar(Rec.Left+2, Rec.Top+4, A);} end; // detekt @@ -500,6 +501,7 @@ begin end; end; +{not used anymore tough we have UGraphicClasses procedure SingDrawStar(X, Y, A: real); var TempR: real; @@ -509,7 +511,7 @@ var W := 32; H := 32; - // Golden Star Patch +// Golden Star Patch // case Z of // 1: glColor4f(1, 1, 1, A); // 2: glColor4f(1, 1, 0.3, A); @@ -530,8 +532,9 @@ var glTexCoord2f((1/16) * Starframe, 1); glVertex2f(X+W, Y-H); glEnd; end; +} - +{not used anymore tough we have UGraphicClasses procedure SingGoldenStar(X, Y, A: real); var TempR: real; @@ -554,7 +557,7 @@ var glTexCoord2f((1/16) * StarfrG2, 1); glVertex2f(X+W, Y-H); glEnd; end; - +} procedure SingDraw; var diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 05a9fda7..8238eace 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -70,6 +70,8 @@ var Tex_BG_Right: array[1..6] of TTexture; Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + Tex_Ball: TTexture; FullScreen: boolean; @@ -186,6 +188,7 @@ begin Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'BMP', 'Alpha Black Colored', Col); end; + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')), 'JPG', 'Font Black', 0); Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index d66bd142..6c131b50 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -8,9 +8,10 @@ type Frame : Byte; //act. Frame Tex : Cardinal; //Tex num from Textur Manager Live : Byte; //How many Cycles before Kill - RecIndex : Integer; //To which rectangle belongs this particle + RecIndex : Integer; //To which rectangle this particle belongs + StarType : Integer; // 1: GoldenNote | 2: PerfectNote - Constructor Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; RecArrayIndex : Integer); + Constructor Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : Integer); procedure Draw; end; @@ -32,7 +33,7 @@ type constructor Create; procedure Draw; - function Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer): Cardinal; + function Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : Integer): Cardinal; procedure SpawnRec(); procedure Kill(index: Cardinal); procedure KillAll(); @@ -47,14 +48,15 @@ implementation uses sysutils, Windows,OpenGl12, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; //TParticle -Constructor TParticle.Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; RecArrayIndex : Integer); +Constructor TParticle.Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : Integer); begin X := cX; Y := cY; Tex := cTex; Live := cLive; Frame:= cFrame; - RecIndex := RecArrayIndex; + RecIndex := cRecArrayIndex; + StarType := cStarType; end; @@ -63,16 +65,27 @@ var W, H: real; Alpha : real; begin - W := 20; - H := 20; - Alpha := (-cos((Frame+1)*2*pi/16)+1); //Fade Eyecandy - glColor4f(0.99, 1, 0.6, Alpha); + Case StarType of + 1: + begin + W := 20; + H := 20; + glColor4f(0.99, 1, 0.6, Alpha); + end; + 2: + begin + W := 30; + H := 30; + glColor4f(1, 1, 0.95, Alpha); + end; + end; + glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); + glBindTexture(GL_TEXTURE_2D, Tex); begin glBegin(GL_QUADS); @@ -139,11 +152,11 @@ begin end; -function TEffectManager.Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer): Cardinal; +function TEffectManager.Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : Integer): Cardinal; begin Result := Length(Particle); SetLength(Particle, (Result + 1)); - Particle[Result] := TParticle.Create(X, Y, Tex, Live, StartFrame, RecArrayIndex); + Particle[Result] := TParticle.Create(X, Y, Tex, Live, StartFrame, RecArrayIndex, StarType); end; @@ -162,7 +175,7 @@ for P:= 0 to high(RecArray) do 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(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, P); + Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, P, 1); inc(RecArray[P].CurrentStarCount); end; end; @@ -183,7 +196,7 @@ for P:= 0 to 2 do Xkatze := RandomRange(ceil(xPos) - 5 , ceil(xPos) + 10); Ykatze := RandomRange(ceil(yPos) - 5 , ceil(yPos) + 10); RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1); + Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); end; draw; end; @@ -265,7 +278,7 @@ begin Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1); + Spawn(Xkatze, Ykatze, Tex_Note_Perfect_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); end; end; -- cgit v1.2.3 From 47c091672034720666ca036e181dcff494ba04ee Mon Sep 17 00:00:00 2001 From: mogguh Date: Fri, 23 Mar 2007 13:54:37 +0000 Subject: Some tidying in UGraphicClasses.pas (actually deleting an unused procedure) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@19 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 20 -------------------- 1 file changed, 20 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 6c131b50..d5eb44ab 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -38,7 +38,6 @@ type procedure Kill(index: Cardinal); procedure KillAll(); procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); - procedure SpawnNotePerfect(xPos,yPos : real); procedure SavePerfectNotePos(Xtop, Ytop: Real); end; @@ -183,25 +182,6 @@ for P:= 0 to high(RecArray) do end; -procedure TEffectManager.SpawnNotePerfect(xPos,yPos : real); -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 2 do - begin - Xkatze := RandomRange(ceil(xPos) - 5 , ceil(xPos) + 10); - Ykatze := RandomRange(ceil(yPos) - 5 , ceil(yPos) + 10); - RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); - end; - draw; -end; - - procedure TEffectManager.Kill(Index: Cardinal); var LastParticleIndex : Cardinal; -- cgit v1.2.3 From 95dc3d90b3eb11080fdcd5edae37cbd35c4ffb57 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 23 Mar 2007 17:40:06 +0000 Subject: Some Changes on Database System and Header Reader Fixed Bug: Scores with 0 are added to DB Made a Class instead of many Functions Fixed a Bug in UFiles, not reading Gap from Header correctly git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@20 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDataBase.pas | 163 ++++++++++++++++++++++++++++++++++++++++ Game/Code/Classes/UFiles.pas | 10 +++ Game/Code/Classes/UScores.pas | 144 ----------------------------------- 3 files changed, 173 insertions(+), 144 deletions(-) create mode 100644 Game/Code/Classes/UDataBase.pas delete mode 100644 Game/Code/Classes/UScores.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas new file mode 100644 index 00000000..1ebc18db --- /dev/null +++ b/Game/Code/Classes/UDataBase.pas @@ -0,0 +1,163 @@ +unit UDataBase; + +interface + +uses USongs, SQLiteTable3; + +//-------------------- +//DataBaseSystem - Class including all DB Methods +//-------------------- +type + TDataBaseSystem = class + private + ScoreDB: TSqliteDatabase; + sFilename: string; + public + + + Destructor Free; + + Procedure Init(const Filename: string); + procedure ReadScore(var Song: TSong); + procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); + procedure WriteScore(var Song: TSong); + end; + +var + DataBase: TDataBaseSystem; + +implementation + +uses IniFiles, SysUtils; + +//-------------------- +//Create - Opens Database and Create Tables if not Exist +//-------------------- + +Procedure TDataBaseSystem.Init(const Filename: string); +begin + //Open Database + ScoreDB := TSqliteDatabase.Create(Filename); + sFilename := Filename; + + try + //Look for Tables => When not exist Create them + if not ScoreDB.TableExists('US_Scores') then + ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + + if not ScoreDB.TableExists('US_Songs') then + ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); + //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper + {if not ScoreDB.TableExists('US_SongCache') then + ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} + + + finally + //ScoreDB.Free; + end; + +end; + +//-------------------- +//Free - Frees Database +//-------------------- +Destructor TDataBaseSystem.Free; +begin + ScoreDB.Free; +end; + +//-------------------- +//ReadScore - Read Scores into SongArray +//-------------------- +procedure TDataBaseSystem.ReadScore(var Song: TSong); +var + TableData: TSqliteTable; + Dif: Byte; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + try + //Search Song in DB + TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); + //Empty Old Scores + SetLength (Song.Score[0], 0); + SetLength (Song.Score[1], 0); + SetLength (Song.Score[2], 0); + + while not TableData.Eof do//Go through all Entrys + begin//Add one Entry to Array + Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); + if (Dif>=0) AND (Dif<=2) then + begin + SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); + + Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); + Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + end; + TableData.Next; + end; + + except //Im Fehlerfall + for Dif := 0 to 2 do + begin + SetLength(Song.Score[Dif], 1); + Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; + end; + end; + finally + //ScoreDb.Free; + end; +end; + +//-------------------- +//AddScore - Add one new Score to DB +//-------------------- +procedure TDataBaseSystem.AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); +var +ID: Integer; +TableData: TSqliteTable; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + //Prevent 0 Scores from being added + if (Score > 0) then + begin + + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Song doesn't exist -> Create + begin + ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Could not Create Table + exit; + end; + //Create new Entry + ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); + + //Delete Last Position when there are more than 5 Entrys + if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then + begin + TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); + ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); + end; + + end; + finally + //ScoreDB.Free; + end; +end; + +//-------------------- +//WriteScore - Not needed with new System; But used for Increment Played Count +//-------------------- +procedure TDataBaseSystem.WriteScore(var Song: TSong); +begin + try + //Increase TimesPlayed + ScoreDB.ExecSQL ('UPDATE `us_songs` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); + except + + end; +end; + +end. diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 61fdab03..fed9b7f1 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -171,6 +171,16 @@ begin //Additional Header Information //--------- + // Video Gap + else if (Identifier = 'GAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.GAP := StrtoFloatDef (Value, 0); + end + //Cover Picture else if (Identifier = 'COVER') then begin diff --git a/Game/Code/Classes/UScores.pas b/Game/Code/Classes/UScores.pas deleted file mode 100644 index f1243868..00000000 --- a/Game/Code/Classes/UScores.pas +++ /dev/null @@ -1,144 +0,0 @@ -unit UScores; - -interface - -uses USongs, SQLiteTable3; - -procedure InitScore(const Filename: string); -procedure ReadScore(var Song: TSong); -procedure WriteScore(var Song: TSong); -procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); - -var -ScoreDB: TSqliteDatabase; -sFilename: string; - -implementation - -uses IniFiles, SysUtils; - -procedure InitScore(const Filename: string); -//var - //TableData: TSqliteTable; -begin - //Open Database - ScoreDB := TSqliteDatabase.Create(Filename); - sFilename := Filename; - - try - //Look for Tables => When not exist Create them - if not ScoreDB.TableExists('US_Scores') then - ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); - - if not ScoreDB.TableExists('US_Songs') then - ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL );'); - - finally - //ScoreDB.Free; - end; - -end; - -procedure ReadScore(var Song: TSong); -var - TableData: TSqliteTable; - Dif: Byte; -begin - //ScoreDB := TSqliteDatabase.Create(sFilename); - try - try - //Search Song in DB - TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); - //Empty Old Scores - SetLength (Song.Score[0], 0); - SetLength (Song.Score[1], 0); - SetLength (Song.Score[2], 0); - - while not TableData.Eof do//Go through all Entrys - begin//Add one Entry to Array - Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); - if (Dif>=0) AND (Dif<=2) then - begin - SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); - - Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); - Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); - end; - TableData.Next; - end; - - except //Im Fehlerfall - for Dif := 0 to 2 do - begin - SetLength(Song.Score[Dif], 1); - Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; - end; - end; - finally - //ScoreDb.Free; - end; -end; - -procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); -var -ID: Integer; -TableData: TSqliteTable; -begin - //ScoreDB := TSqliteDatabase.Create(sFilename); - try - - ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); - if ID = 0 then //Song doesn't exist -> Create - begin - ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '");'); - ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); - if ID = 0 then //Could not Create Table - exit; - end; - //Create new Entry - ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); - - //Delete Last Position when there are more than 5 Entrys - if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then - begin - TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); - ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); - end; - - finally - //ScoreDB.Free; - end; -end; - -//Not used with new SQLLite DB System -procedure WriteScore(var Song: TSong); -{var - F: TIniFile; - S: integer; - Lev: integer; - LevS: string; - FileName: string;} -begin - {FileName := Song.Path + ChangeFileExt(Song.FileName, '.sco'); - if (not FileExists(FileName)) or (FileExists(FileName) and DeleteFile(FileName)) then begin - // file has been deleted -> creating new file - F := TIniFile.Create(FileName); - - for Lev := 0 to 2 do begin - case Lev of - 0: LevS := 'Easy'; - 1: LevS := 'Normal'; - 2: LevS := 'Hard'; - end; - - for S := 0 to high(Song.Score[Lev]) do begin - F.WriteString(LevS + IntToStr(S+1), 'Name', Song.Score[Lev, S].Name); - F.WriteInteger(LevS + IntToStr(S+1), 'Score', Song.Score[Lev, S].Score); - - end; // for S - end; // for Lev - F.Free; - end; // if} -end; - -end. -- cgit v1.2.3 From 7c809200754d707f440ec45686692db405da8ae1 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 24 Mar 2007 12:23:00 +0000 Subject: Fixed Bug: Not translating Texts reading Theme.Ini Compiler doesn't define CompilerConst Translate correctly. Fixed by Commenting IFDEF Operations out git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@21 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index c4b83d8b..7dbac5a9 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -3,9 +3,6 @@ unit UThemes; interface uses -{$IFDEF TRANSLATE} - ULanguage, -{$ENDIF} IniFiles, SysUtils, Classes; type @@ -580,6 +577,9 @@ var implementation uses +{{$IFDEF TRANSLATE} + ULanguage, +{{$ENDIF} USkins, UIni; constructor TTheme.Create(FileName: string); @@ -716,7 +716,7 @@ begin //Score Text Translation Start - {$IFDEF TRANSLATE} + {{$IFDEF TRANSLATE} Main.Description[0] := Language.Translate('SING_SING'); Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); Main.Description[1] := Language.Translate('SING_EDITOR'); @@ -725,7 +725,7 @@ begin Main.DescriptionLong[2] := Language.Translate('SING_GAME_OPTIONS_DESC'); Main.Description[3] := Language.Translate('SING_EXIT'); Main.DescriptionLong[3] := Language.Translate('SING_EXIT_DESC'); - {$ENDIF} + {{$ENDIF} //Score Text Translation End @@ -910,7 +910,7 @@ begin ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); - {$IFDEF TRANSLATE} + {{$IFDEF TRANSLATE} Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); @@ -918,7 +918,7 @@ begin Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); Options.Description[6] := Language.Translate('SING_OPTIONS_EXIT'); - {$ENDIF} + {{$ENDIF} ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); Options.TextDescription.Text := Options.Description[0]; @@ -1137,9 +1137,9 @@ begin ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); - {$IFDEF TRANSLATE} + {{$IFDEF TRANSLATE} ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {$ELSE} + {{$ELSE}{ ThemeText.Text := ThemeIni.ReadString(Name, 'Text', ''); {$ENDIF} @@ -1268,9 +1268,9 @@ var begin DecimalSeparator := '.'; - {$IFDEF TRANSLATE} + {{$IFDEF TRANSLATE} ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {$ELSE} + {{$ELSE}{ ThemeSelect.Text := ThemeIni.ReadString(Name, 'Text', ''); {$ENDIF} @@ -1314,9 +1314,9 @@ var begin DecimalSeparator := '.'; - {$IFDEF TRANSLATE} + {{$IFDEF TRANSLATE} ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {$ELSE} + {{$ELSE}{ ThemeSelectS.Text := ThemeIni.ReadString(Name, 'Text', ''); {$ENDIF} -- cgit v1.2.3 From 5ce375d1b7493e41a3ac14b979932d6cf7d73285 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 24 Mar 2007 13:37:12 +0000 Subject: Copyed PNG Texture Support from UltraStar 0.5.3 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@23 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 767d53ec..b50ab6bf 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; //procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; @@ -192,6 +192,7 @@ var Res: TResourceStream; TextureB: TBitmap; TextureJ: TJPEGImage; + TexturePNG: TPNGObject; Pet: integer; Pet2: integer; @@ -215,10 +216,14 @@ begin end; if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin - TextureB := TBitmap.Create; - if Format = 'JPG' then begin + if Format = 'BMP' then begin + if FromRegistry then TextureB.LoadFromStream(Res) + else TextureB.LoadFromFile(Nazwa); + end + + else if Format = 'JPG' then begin TextureJ := TJPEGImage.Create; if FromRegistry then TextureJ.LoadFromStream(Res) else begin @@ -229,10 +234,19 @@ begin end; TextureB.Assign(TextureJ); TextureJ.Free; - end; - if Format = 'BMP' then begin - if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Nazwa); + end + + else if Format = 'PNG' then begin + TexturePNG := TPNGObject.Create; + if FromRegistry then TexturePNG.LoadFromStream(Res) + else begin + if FileExists(Nazwa) then + TexturePNG.LoadFromFile(Nazwa) + else + Exit; + end; + TextureB.Assign(TexturePNG); + TexturePNG.Free; end; if FromRegistry then Res.Free; -- cgit v1.2.3 From 467e742c7c03c78f0de5053cfe012cf6a9299960 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 24 Mar 2007 14:01:23 +0000 Subject: Changed Fonts from BMP to PNG git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@24 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index cf09e48b..0f4ae82e 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -62,25 +62,25 @@ begin ActFont := 0; SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'BMP', 'Font', 0); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); Fonts[0].Tex.H := 30; Fonts[0].AspectW := 0.9; Fonts[0].Done := -1; Fonts[0].Outline := 0; - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'BMP', 'Font', 0); + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); Fonts[1].Tex.H := 30; Fonts[1].AspectW := 1; Fonts[1].Done := -1; Fonts[1].Outline := 0; - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'BMP', 'Font Outline', 0); + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Font Outline', 0); Fonts[2].Tex.H := 30; Fonts[2].AspectW := 0.95; Fonts[2].Done := -1; Fonts[2].Outline := 5; - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'BMP', 'Font Outline 2', 0); + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Font Outline 2', 0); Fonts[3].Tex.H := 30; Fonts[3].AspectW := 0.95; Fonts[3].Done := -1; -- cgit v1.2.3 From 60521ca33e23a91f2ea8aecf506b9aa5e6bda54a Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 25 Mar 2007 10:41:53 +0000 Subject: 2 Bugs in Cover Positions fixed: Style4 (Classic): Positions now Readed from Theme, No Overlapping Style5 (Deluxe): correct Positions of Covers in the Front No Cut from Last to First Todo: Correct Positions of Covers in the back(Now Invisible) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@32 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 7dbac5a9..1d632073 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -759,11 +759,11 @@ begin //Load Cover Pos and Size from Theme Mod Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 400); - Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 100); + Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 140); Song.Cover.Z := ThemeIni.ReadInteger('SongCover', 'Z', 250); - Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 200); + Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); - Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 5); + 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 -- cgit v1.2.3 From 2bcebe90daa1865f1bc335d1f2fc2ca31637bc59 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 25 Mar 2007 11:24:07 +0000 Subject: Some Code Cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@33 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 1d632073..e9aa2141 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -780,6 +780,15 @@ begin 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; + //Load Equalizer Pos and Size from Theme Mod End + //Party Mode ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1'); ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2'); @@ -799,15 +808,6 @@ begin ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); - //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; - //Load Equalizer Pos and Size from Theme Mod End - // Sing ThemeLoadBasic(Sing, 'Sing'); -- cgit v1.2.3 From ccb5946db9ae26b5b40a171110e4a5fc595cb0bf Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 25 Mar 2007 15:20:46 +0000 Subject: Changed Music.SetVolume from Global Wave Volume to Application-Only BassConfig git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@35 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index db1675c5..f7f0e20d 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -342,7 +342,12 @@ end; procedure TMusic.SetVolume(Volume: integer); begin - BASS_SetVolume(Volume); + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); end; procedure TMusic.SetLoop(Enabled: boolean); -- cgit v1.2.3 From 3ba33f8e920a9e9a3114f159e2b6fda4273a6efb Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 28 Mar 2007 13:08:41 +0000 Subject: Added Jumpto Ability to SongScreen (Press J) Fixed: Golden Notes are not shown in PartyMode git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@39 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 9 +++-- Game/Code/Classes/USongs.pas | 77 ++++++++++++++++++++++++++++++++++++------ Game/Code/Classes/UThemes.pas | 16 ++++++++- 3 files changed, 87 insertions(+), 15 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 8238eace..d9831143 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -6,7 +6,7 @@ uses UScreenWelcome, UScreenMain, UScreenName, UScreenLevel, UScreenOptions, UScreenOptionsGame, UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, - UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, + UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer; type @@ -51,6 +51,7 @@ var ScreenOpen: TScreenOpen; ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; //Party Screens ScreenSingModi: TScreenSingModi; @@ -390,9 +391,11 @@ begin ScreenOpen := TScreenOpen.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - //ScreenSongMenu := TScreenSongMenu.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); ScreenPartyNewRound := TScreenPartyNewRound.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); ScreenPartyScore := TScreenPartyScore.Create; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index c2532a03..5b75879d 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -82,6 +82,8 @@ type function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song function VisibleSongs: integer; // returns number of visible songs (for tabs) function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; end; var @@ -91,7 +93,7 @@ var implementation -uses UPliki, UIni, UFiles; +uses UPliki, UIni, UFiles, StrUtils; procedure TSongs.LoadSongList; begin @@ -572,12 +574,12 @@ var S: integer; // song begin CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].OrderNum = Index then + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then CatSongs.Song[S].Visible := true else - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false; + CatSongs.Song[S].Visible := false; end; end; @@ -599,12 +601,6 @@ begin if Num <> CatNumShow then begin ShowCategory(Num); - //Hide Categorys when in Category Hack - for S := low(CatSongs.Song) to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then //Hide all Cats - CatSongs.Song[S].Visible := false - end; - //Hide Categorys when in Category Hack End end else begin ShowCategoryList; @@ -664,4 +660,63 @@ begin if CatSongs.Song[S].Visible = true then Inc(Result); end; +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index e9aa2141..e31e94d2 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -393,6 +393,12 @@ type TextMenu: TThemeText; end; + TThemeSongJumpTo = class(TThemeBasic) + ButtonSearchText: TThemeButton; + SelectSlideType: TThemeSelectSlide; + TextFound: TThemeText; + end; + //Party Screens TThemePartyNewRound = class(TThemeBasic) TextRound1: TThemeText; @@ -525,6 +531,7 @@ type OptionsRecord: TThemeOptionsRecord; //Menu SongMenu: TThemeSongMenu; + SongJumpto: TThemeSongJumpTo; //Party Screens: PartyNewRound: TThemePartyNewRound; PartyScore: TThemePartyScore; @@ -606,6 +613,7 @@ begin OptionsRecord := TThemeOptionsRecord.Create; SongMenu := TThemeSongMenu.Create; + SongJumpto := TThemeSongJumpto.Create; //Party Screens PartyNewRound := TThemePartyNewRound.Create; PartyWin := TThemePartyWin.Create; @@ -980,7 +988,7 @@ begin ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); - //Song Menu + //Song Menu ThemeLoadBasic (SongMenu, 'SongMenu'); ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1'); ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2'); @@ -990,6 +998,12 @@ begin ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu'); + //Song Jumpto + ThemeLoadBasic (SongJumpto, 'SongJumpto'); + ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText'); + ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType'); + ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound'); + //Party Screens: //Party NewRound ThemeLoadBasic(PartyNewRound, 'PartyNewRound'); -- cgit v1.2.3 From 8d591b8344e0cb87e1a987961b3790fa26d323a6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 29 Mar 2007 12:40:11 +0000 Subject: Fixed Some Bugs in JumpTo Screen: Now plays correct music Space Bug is gone Added onSentenceChange Procedure to ScreenSing git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@48 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 3 +++ Game/Code/Classes/USongs.pas | 1 + 2 files changed, 4 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 3ef65e1d..f92b9457 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -387,6 +387,9 @@ begin end; Sender.UpdateLCD; + + //On Sentence Change... + Sender.onSentenceChange(Czesci[0].Akt); end; procedure NewBeat(Sender: TScreenSing); diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 5b75879d..cc3c8b95 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -669,6 +669,7 @@ begin {fType: 0: All 1: Title 2: Artist} + FilterStr := Trim(FilterStr); if FilterStr<>'' then begin Result := 0; //Create Search Array -- cgit v1.2.3 From e0e16a3b1d28cf51fecf669d42465cf2a65728f3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 29 Mar 2007 16:54:52 +0000 Subject: Added SBGW to TSelectSlide: Defining the Width of the Selections BG Added W to TText + Pagebreaks. If Width is given the Text breaks at the given width. Breaks are not generated perfect yet, needs some tuning. Changed all affected Screens to fit the new TText Component git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@49 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index e31e94d2..a62c5aed 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -97,6 +97,7 @@ type TThemeText = record X: integer; Y: integer; + W: integer; Color: string; ColR: real; ColG: real; @@ -156,6 +157,10 @@ type Y: integer; W: integer; H: integer; + + //SBGW Mod + SBGW: integer; + Text: string; ColR, ColG, ColB, Int: real; DColR, DColG, DColB, DInt: real; @@ -1142,6 +1147,7 @@ begin DecimalSeparator := '.'; 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); @@ -1343,6 +1349,7 @@ begin ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0); 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); -- cgit v1.2.3 From 563375e18e4aeba0152a9761f1f84d66aaeb27d2 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 30 Mar 2007 12:19:08 +0000 Subject: Finished Code for Plugin Sound PlayBack Removed Debug Message from ULanguage git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@50 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULanguage.pas | 4 +--- Game/Code/Classes/UMusic.pas | 11 +++++++++-- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index afdac87c..b911b90a 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -52,7 +52,7 @@ begin Implode_Glue2 := ' and '; if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading - Log.CriticalError('Could not load any Language Files'); + Log.CriticalError('Could not load any Language File'); //Standard Language (If a Language File is Incomplete) //Then use English Language @@ -143,8 +143,6 @@ begin Result := Text; Text := Uppercase(Result); - Log.LogError('Text: "' + Text + '" L: ' + InttoStr(Length(Entry))); - //Const Mod for E := 0 to high(CEntry) do if Text = CEntry[E].ID then diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index f7f0e20d..0e4e4ddd 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -731,11 +731,18 @@ begin end; function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; begin if FileExists(Name) then begin Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadPlayerFromFile'); try hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; except Log.LogError('Failed to open using BASS', 'LoadPlayerFromFile'); end; @@ -762,7 +769,7 @@ var F: String; begin //Search for Sound in already loaded Sounds - F := UpperCase(FileName); + F := UpperCase(SoundPath + FileName); For I := 0 to High(CustomSounds) do begin if (UpperCase(CustomSounds[I].Filename) = F) then @@ -772,7 +779,7 @@ begin end; end; - if LoadSoundFromFile(S, Filename) then + if LoadSoundFromFile(S, SoundPath + Filename) then Result := High(CustomSounds) else Result := 0; -- cgit v1.2.3 From 5c46c303e25f84e49e36918bafc8d7eca09a507b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 5 Apr 2007 13:43:20 +0000 Subject: Fixed: Button.Z Attribut not loaded from Theme Fixed: AddButton procedure don't set Result git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@58 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 50 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 44 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index a62c5aed..d2fb5b11 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -113,6 +113,7 @@ type Text: AThemeText; X: integer; Y: integer; + Z: Real; W: integer; H: integer; Color: string; @@ -280,6 +281,9 @@ type StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG TextP3R: TThemeText; TextP3RScore: TThemeText; + + //Linebonus Translations + LineBonusText: Array [0..8] of String; end; TThemeScore = class(TThemeBasic) @@ -402,6 +406,12 @@ type ButtonSearchText: TThemeButton; SelectSlideType: TThemeSelectSlide; TextFound: TThemeText; + + //Translated Texts + Songsfound: String; + NoSongsfound: String; + CatText: String; + IType: array [0..2] of String; end; //Party Screens @@ -512,6 +522,11 @@ type ButtonPrev: TThemeButton;} end; + //Playlist Translations + TThemePlaylist = record + CatText: string; + end; + TTheme = class {$IFDEF THEMESAVE} ThemeIni: TIniFile; @@ -541,8 +556,10 @@ type PartyNewRound: TThemePartyNewRound; PartyScore: TThemePartyScore; PartyWin: TThemePartyWin; - PartyOptions: TThemePartyOptions; - PartyPlayer: TThemePartyPlayer; + PartyOptions: TThemePartyOptions; + PartyPlayer: TThemePartyPlayer; + + Playlist: TThemePlaylist; constructor Create(FileName: string); overload; // Initialize theme system constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color @@ -871,6 +888,16 @@ begin ThemeLoadText(Sing.TextP3R, 'SingP3RText'); ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); + //Line Bonus Texts + Sing.LineBonusText[0] := Language.Translate('LINEBONUS_WORST'); + Sing.LineBonusText[1] := Sing.LineBonusText[0]; + Sing.LineBonusText[2] := Language.Translate('LINEBONUS_BAD'); + Sing.LineBonusText[3] := Language.Translate('LINEBONUS_NORMAL'); + Sing.LineBonusText[4] := Sing.LineBonusText[3]; + Sing.LineBonusText[5] := Language.Translate('LINEBONUS_GOOD'); + Sing.LineBonusText[6] := Language.Translate('LINEBONUS_BETTER'); + Sing.LineBonusText[7] := Sing.LineBonusText[6]; + Sing.LineBonusText[8] := Language.Translate('LINEBONUS_PERFECT'); // Score ThemeLoadBasic(Score, 'Score'); @@ -1008,6 +1035,13 @@ begin 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 @@ -1122,6 +1156,9 @@ begin {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} + + //Playlist Translations + Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT') end; ThemeIni.Free; @@ -1239,10 +1276,11 @@ var begin DecimalSeparator := '.'; ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); - ThemeButton.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeButton.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeButton.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeButton.H := ThemeIni.ReadInteger(Name, 'H', 0); + 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 := ThemeIni.ReadString(Name, 'Type', ''); -- cgit v1.2.3 From e2cd03822f28a4866f98fb0893a73b02bd60ce03 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 5 Apr 2007 14:37:58 +0000 Subject: Added Playlist Support Working correct with Standard Mode Only for now Now working on Playlist Support for Party Mode git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@59 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPliki.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPliki.pas b/Game/Code/Classes/UPliki.pas index 475a3752..f7692990 100644 --- a/Game/Code/Classes/UPliki.pas +++ b/Game/Code/Classes/UPliki.pas @@ -22,6 +22,7 @@ var CoversPath: string; LanguagesPath: string; PluginPath: string; + PlayListPath: string; Plik: TextFile; // all procedures in this unit operates on this file PlikC: char; @@ -49,6 +50,8 @@ begin //Modi Loader PluginPath := GamePath + 'Plugins\'; + PlaylistPath := GamePath + 'Playlists\'; + DecimalSeparator := ','; end; -- cgit v1.2.3 From 34c7a7472078bd6f1d5551dedc9efd2ccccbc7c8 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 5 Apr 2007 14:52:11 +0000 Subject: Added Playlist Support git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@61 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 398 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 398 insertions(+) create mode 100644 Game/Code/Classes/UPlaylist.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas new file mode 100644 index 00000000..585f9271 --- /dev/null +++ b/Game/Code/Classes/UPlaylist.pas @@ -0,0 +1,398 @@ +unit UPlaylist; + +interface + +type + TPlaylistItem = record + Artist: String; + Title: String; + SongID: Integer; + end; + + APlaylistItem = array of TPlaylistItem; + + TPlaylist = record + Name: String; + Filename: String; + Items: APlaylistItem; + end; + + APlaylist = array of TPlaylist; + + //---------- + //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) + //---------- + TPlaylistManager = class + private + + public + Mode: Byte; //Current Playlist Mode for SongScreen + CurPlayList: Cardinal; + CurItem: Cardinal; + + Playlists: APlaylist; + + constructor Create; + Procedure LoadPlayLists; + Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; + Procedure SavePlayList(Index: Cardinal); + + Procedure SetPlayList(Index: Cardinal); + + Function AddPlaylist(Name: String): Cardinal; + + Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); + Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); + + Procedure GetNames(var PLNames: array of String); + Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; + end; + + {Modes: + 0: Standard Mode + 1: PlayList Mode + 2: Category Mode} + + var + PlayListMan: TPlaylistManager; + + +implementation +uses USongs, ULog, UPliki, UGraphic, UThemes, SysUtils; + +//---------- +//Create - Construct Class - Dummy for now +//---------- +constructor TPlayListManager.Create; +begin + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; +begin + SetLength(Playlists, 0); + + if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then + begin + repeat + Len := Length(Playlists); + SetLength(Playlists, Len +1); + + if not LoadPlayList (Len, Sr.Name) then + SetLength(Playlists, Len); + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +//---------- +//LoadPlayList - Load a Playlist in the Array +//---------- +Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; + var + F: TextFile; + Line: String; + PosDelimiter: Integer; + SongID: Integer; + Len: Integer; + + Function FindSong(Artist, Title: String): Integer; + var I: Integer; + begin + Result := -1; + + For I := low(CatSongs.Song) to high(CatSongs.Song) do + begin + if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then + begin + Result := I; + Break; + end; + end; + end; +begin + if not FileExists(PlayListPath + Filename) then + begin + Log.LogError('Could not load Playlist: ' + Filename); + Result := False; + Exit; + end; + Result := True; + + //Load File + AssignFile(F, PlayListPath + FileName); + Reset(F); + + //Set Filename + PlayLists[Index].Filename := Filename; + PlayLists[Index].Name := ''; + + //Read Until End of File + While not Eof(F) do + begin + //Read Curent Line + Readln(F, Line); + + if (Length(Line) > 0) then + begin + PosDelimiter := Pos(':', Line); + if (PosDelimiter <> 0) then + begin + //Comment or Name String + if (Line[1] = '#') then + begin + //Found Name Value + if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then + PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) + + end + //Song Entry + else + begin + SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); + if (SongID <> -1) then + begin + Len := Length(PlayLists[Index].Items); + SetLength(PlayLists[Index].Items, Len + 1); + + PlayLists[Index].Items[Len].SongID := SongID; + + PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); + PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); + end + else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); + end; + end; + end; + end; + + //If no special name is given, use Filename + if PlayLists[Index].Name = '' then + begin + PlayLists[Index].Name := ChangeFileExt(FileName, ''); + end; + + //Finish (Close File) + CloseFile(F); +end; + +//---------- +//SavePlayList - Saves the specified Playlist +//---------- +Procedure TPlayListManager.SavePlayList(Index: Cardinal); +var + F: TextFile; + I: Integer; +begin + if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then + begin + + //open File for Rewriting + AssignFile(F, PlaylistPath + Playlists[Index].Filename); + try + Rewrite(F); + + //Write Version (not nessecary but helpful) + WriteLn(F, '######################################'); + WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); + WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); + WriteLn(F, '######################################'); + + //Write Name Information + WriteLn(F, '#Name: ' + Playlists[Index].Name); + + //Write Song Information + WriteLn(F, '#Songs:'); + + For I := 0 to high(Playlists[Index].Items) do + begin + WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + end; + + finally + CloseFile(F); + end; + end; +end; + +//---------- +//SetPlayList - Display a Playlist in CatSongs +//---------- +Procedure TPlayListManager.SetPlayList(Index: Cardinal); +var + I: Integer; +begin + If (Index > High(PlayLists)) then + exit; + + //Hide all Songs + For I := 0 to high(CatSongs.Song) do + CatSongs.Song[I].Visible := False; + + //Show Songs in PL + For I := 0 to high(PlayLists[Index].Items) do + begin + CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; + end; + + //Set CatSongsMode + Playlist Mode + CatSongs.CatNumShow := -3; + Mode := 1; + + //Show Cat in Topleft: + ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); + + //Fix SongSelection + ScreenSong.Interaction := 0; + ScreenSong.SelectNext; + ScreenSong.FixSelected; + + //Play correct Music + ScreenSong.ChangeMusic; +end; + +//---------- +//AddPlaylist - Adds a Playlist and Returns the Index +//---------- +Function TPlayListManager.AddPlaylist(Name: String): Cardinal; +var I: Integer; +begin + Result := Length(Playlists); + SetLength(Playlists, Result + 1); + + Playlists[Result].Name := Name; + + I := 1; + + if (not FileExists(PlaylistPath + Name + '.upl')) then + Playlists[Result].Filename := Name + '.upl' + else + begin + repeat + Inc(I); + until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); + Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; + end; + + //Save new Playlist + SavePlayList(Result); +end; + +//---------- +//AddItem - Adds an Item to a specific Playlist +//---------- +Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); +var + P: Cardinal; + Len: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (SongID <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then + begin + Len := Length(Playlists[P].Items); + SetLength(Playlists[P].Items, Len + 1); + + Playlists[P].Items[Len].SongID := SongID; + Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; + Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; + + //Save Changes + SavePlayList(P); + + //Correct Display when Editing current Playlist + if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); + end; +end; + +//---------- +//DelItem - Deletes an Item from a specific Playlist +//---------- +Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); +var + I: Integer; + P: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (iItem <= high(Playlists[P].Items)) then + begin + //Move all entrys behind deleted one to Front + For I := iItem to High(Playlists[P].Items) - 1 do + Playlists[P].Items[I] := Playlists[P].Items[I + 1]; + + //Delete Last Entry + SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); + + //Save Changes + SavePlayList(P); + end; + + //Correct Display when Editing current Playlist + if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); +end; + +//---------- +//GetNames - Writes Playlist Names in a Array +//---------- +Procedure TPlayListManager.GetNames(var PLNames: array of String); +var + I: Integer; + Len: Integer; +begin + Len := High(Playlists); + + if (Length(PLNames) <> Len + 1) then + exit; + + For I := 0 to Len do + PLNames[I] := Playlists[I].Name; +end; + +//---------- +//GetIndexbySongID - Returns Index in the specified Playlist of the given Song +//---------- +Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; +var + P: Integer; + I: Integer; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + Result := -1; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = SongID) then + begin + Result := I; + Break; + end; + end; +end; + +end. -- cgit v1.2.3 From 9d01c8801db29d6ff3d64ef81b84321549d84688 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 5 Apr 2007 21:09:52 +0000 Subject: Added Advanced Screen and Options in TIni Options working now only for Effect Perfect and Effect Golden. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@65 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 26 ++- Game/Code/Classes/UGraphic.pas | 42 +++- Game/Code/Classes/UIni.pas | 160 +++++++-------- Game/Code/Classes/UThemes.pas | 442 ++++++++++++++++++++++------------------- 4 files changed, 358 insertions(+), 312 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 2e742172..e0e8e941 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -215,11 +215,17 @@ begin with Nuta[Pet] do begin if not FreeStyle then begin - // Golden Note Patch - case Wartosc of - 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 1, 0.85); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - end; // case + + if Ini.EffectGolden = 0 then + // If Golden note Effect of then Change not Color + begin + case Wartosc of + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); + end; // case + end //Else all Notes same Color + else + glColor4f(1, 1, 1, 0.85); // lewa czesc - left part Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; @@ -264,10 +270,10 @@ begin glEnd; // Golden Star Patch - if Wartosc = 2 then - begin - GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); - end; + if (Wartosc = 2) AND (Ini.EffectGolden=1) then + begin + GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); + end; end; // if not FreeStyle end; // with @@ -373,7 +379,7 @@ var //Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; //if (Start+Dlugosc-1 = Czas.AktBeatD) then - if Perfect AND (Ini.GMAFix <> 1) then begin + if Perfect and (Ini.EffectPerfect=1) then begin // A := sqrt((1+sin(Music.Position * 3))/2); A := 1 - 2*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); if not (Start+Dlugosc-1 = Czas.AktBeatD) then diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index d9831143..73bb1706 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -4,7 +4,7 @@ interface uses SDL, OpenGL12, UTexture, TextGL, ULog, SysUtils, ULyrics, UScreenLoading, UScreenWelcome, UScreenMain, UScreenName, UScreenLevel, UScreenOptions, UScreenOptionsGame, - UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, + UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, UScreenOptionsAdvanced, UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer; @@ -44,6 +44,7 @@ var ScreenOptionsLyrics: TScreenOptionsLyrics; ScreenOptionsThemes: TScreenOptionsThemes; ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; ScreenEditSub: TScreenEditSub; ScreenEdit: TScreenEdit; ScreenEditConvert: TScreenEditConvert; @@ -162,7 +163,7 @@ procedure LoadScreens; implementation -uses UMain, UIni, UDisplay; +uses UMain, UIni, UDisplay, Graphics, Classes, Windows; procedure LoadTextures; var @@ -215,13 +216,36 @@ begin end; procedure Initialize3D (Title: string); +var + Icon: TIcon; + Res: TResourceStream; + ISurface: PSDL_Surface; begin Log.LogStatus('LoadOpenGL', 'Initialize3D'); Log.BenchmarkStart(2); LoadOpenGL; -// SDL_WM_SetIcon(SDL_LoadBMP('..\Graphics\us.ico'),0); + {//Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + + //Create icon Surface + SDL_CreateRGBSurface ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + SDL_BlitSurface( //} + + + SDL_WM_SetIcon(SDL_LoadBMP('us.ico'), 0); //} Log.LogStatus('SDL_Init', 'Initialize3D'); if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin @@ -370,16 +394,18 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); ScreenOptionsGame := TScreenOptionsGame.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create(''); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create(''); + ScreenOptionsSound := TScreenOptionsSound.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create(''); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create(''); + ScreenOptionsThemes := TScreenOptionsThemes.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; + ScreenOptionsRecord := TScreenOptionsRecord.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); ScreenEditSub := TScreenEditSub.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); ScreenEdit := TScreenEdit.Create(''); diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index a17ba52d..7ab8de99 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -27,11 +27,6 @@ type Spectrum: integer; Spectrograph: integer; MovieSize: integer; - //LineBonus Mod - LineBonus: integer; - //GMA Fix - GMAFix: integer; - // Sound MicBoost: integer; @@ -61,6 +56,14 @@ type ChannelR: integer; end; + // Advanced + LoadAnimation: integer; + EffectPerfect: integer; + EffectGolden: integer; + AskbeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + // Controller Joypad: integer; @@ -113,11 +116,6 @@ const IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); //IOscilloscope: array[0..1] of string = ('Off', 'On'); - //Line Bonus MOd - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - //GMA Fix - IGMAFix: array[0..1] of string = ('Off', 'On'); - ISpectrum: array[0..1] of string = ('Off', 'On'); ISpectrograph: array[0..1] of string = ('Off', 'On'); IMovieSize: array[0..1] of string = ('Half', 'Full'); @@ -135,6 +133,14 @@ const IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectPerfect: array[0..1] of string = ('Off', 'On'); + IEffectGolden: array[0..1] of string = ('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IJoypad: array[0..1] of string = ('Off', 'On'); ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); @@ -257,16 +263,6 @@ begin for Pet := 0 to High(IOscilloscope) do if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; - // Line Bonus - Tekst := IniFile.ReadString('Graphics', 'LineBonus', 'At Score'); - for Pet := 0 to High(ILineBonus) do - if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - - //GMA Fix - Tekst := IniFile.ReadString('Graphics', 'GMAFix', 'Off'); - for Pet := 0 to High(IGMAFix) do - if Tekst = IGMAFix[Pet] then Ini.GMAFix := Pet; - // Spectrum Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); for Pet := 0 to High(ISpectrum) do @@ -307,22 +303,6 @@ begin for Pet := 0 to High(IThreshold) do if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; - {// Two Player Mode - for I := 0 to 7 do begin - Ini.SoundCard[I, 1] := 2*I + 1; - Ini.SoundCard[I, 2] := 2*I + 2; - end; - - Tekst := IniFile.ReadString('Sound', 'TwoPlayerMode', ITwoPlayerMode[0]); - for Pet := 0 to High(ITwoPlayerMode) do - if Tekst = ITwoPlayerMode[Pet] then Ini.TwoPlayerMode := Pet; - - if Ini.TwoPlayerMode = 1 then begin - Ini.SoundCard[0, 1] := 1; - Ini.SoundCard[0, 2] := 3; - Ini.SoundCard[1, 1] := 2; - end;} - // Lyrics Font Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); for Pet := 0 to High(ILyricsFont) do @@ -339,15 +319,6 @@ begin if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; // Theme - {SetLength(ITheme, 0); - if FileExists('Themes\Singstar.ini') then begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := 'Singstar'; - end; { - if FileExists('Themes\Karin.ini') then begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := 'Karin'; - end;} //Theme List Patch SetLength(ITheme, 0); @@ -372,8 +343,7 @@ begin //No Theme Found if (Length(ITheme)=0) then begin - Log.LogError('Could not find any valid Themes.'); - Halt; + Log.CriticalError('Could not find any valid Themes.'); end; @@ -425,8 +395,6 @@ begin Inc(I); end; - Log.LogError(InttoStr(Length(CardList)) + ' Cards Loaded'); - // Record - append detected soundcards for I := 0 to High(Recording.SoundCard) do begin @@ -455,40 +423,45 @@ begin end; end; - {for I := 0 to High(Recording.SoundCard) do begin + //Advanced Settings - B := false; - I2 := 0; - while ((B = false) and (I2 <= High(CardList))) do - if CardList[I2].Name = Recording.SoundCard[I].Description then B := true - else Inc(I2); + // LoadAnimation + Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); + for Pet := 0 to High(ILoadAnimation) do + if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; + + // EffectPerfect + Tekst := IniFile.ReadString('Advanced', 'EffectPerfect', 'On'); + for Pet := 0 to High(IEffectPerfect) do + if Tekst = IEffectPerfect[Pet] then Ini.EffectPerfect := Pet; + + // EffectGolden + Tekst := IniFile.ReadString('Advanced', 'EffectGolden', 'On'); + for Pet := 0 to High(IEffectGolden) do + if Tekst = IEffectGolden[Pet] then Ini.EffectGolden := Pet; + + // AskbeforeDel + Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); + for Pet := 0 to High(IAskbeforeDel) do + if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; + + // OnSongClick + Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); + for Pet := 0 to High(IOnSongClick) do + if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; + + // Linebonus + Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - // if the card wasn't detected in ini file, append it to the ini list - if B = false then begin - I3 := Length(CardList); - SetLength(CardList, I3+1); - CardList[I3].Name := Recording.SoundCard[I].Description; - CardList[I3].Input := 0; - CardList[I3].ChannelL := 0; - CardList[I3].ChannelR := 0; - if Length(CardList) = 1 then CardList[I].ChannelL := 1; // default for new users - //CardList[I].Input := 2; - end; - end; } - Log.LogError(InttoStr(Length(CardList)) + ' Cards Detected'); // Joypad Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); for Pet := 0 to High(IJoypad) do if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - {// SoundCard - for I := 0 to 7 do begin - Ini.SoundCard[I, 1] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'L', Ini.SoundCard[I, 1]); - Ini.SoundCard[I, 2] := IniFile.ReadInteger('SoundCards', 'SoundCard'+IntToStr(I+1)+'R', Ini.SoundCard[I, 2]); - end; } - // LCD Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); for Pet := 0 to High(ILPT) do @@ -564,14 +537,6 @@ begin Tekst := IOscilloscope[Ini.Oscilloscope]; IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Graphics', 'LineBonus', Tekst); - - //GMA Fix - Tekst := IGMAFix[Ini.GMAFix]; - IniFile.WriteString('Graphics', 'GMAFix', Tekst); - // Spectrum Tekst := ISpectrum[Ini.Spectrum]; IniFile.WriteString('Graphics', 'Spectrum', Tekst); @@ -604,10 +569,6 @@ begin Tekst := ISavePlayback[Ini.SavePlayback]; IniFile.WriteString('Sound', 'SavePlayback', Tekst); - {// Two Player Mode - Tekst := ITwoPlayerMode[Ini.TwoPlayerMode]; - IniFile.WriteString('Sound', 'TwoPlayerMode', Tekst); } - // Lyrics Font Tekst := ILyricsFont[Ini.LyricsFont]; IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); @@ -651,6 +612,33 @@ begin Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + //Advanced Settings + + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + + //EffectPerfect + Tekst := IEffectPerfect[Ini.EffectPerfect]; + IniFile.WriteString('Advanced', 'EffectPerfect', Tekst); + + //EffectGolden + Tekst := IEffectGolden[Ini.EffectGolden]; + IniFile.WriteString('Advanced', 'EffectGolden', Tekst); + + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); + + // Joypad Tekst := IJoypad[Ini.Joypad]; IniFile.WriteString('Controller', 'Joypad', Tekst); diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index d2fb5b11..17983a60 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -333,10 +333,11 @@ type ButtonLyrics: TThemeButton; ButtonThemes: TThemeButton; ButtonRecord: TThemeButton; + ButtonAdvanced: TThemeButton; ButtonExit: TThemeButton; TextDescription: TThemeText; - Description: array[0..6] of string; + Description: array[0..7] of string; end; TThemeOptionsGame = class(TThemeBasic) @@ -390,6 +391,16 @@ type ButtonExit: TThemeButton; end; + TThemeOptionsAdvanced = class(TThemeBasic) + SelectLoadAnimation: TThemeSelect; + SelectEffectPerfect: TThemeSelect; + SelectEffectGolden: TThemeSelect; + SelectLineBonus: TThemeSelect; + SelectAskbeforeDel: TThemeSelect; + SelectOnSongClick: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + //ScreenSong Menue TThemeSongMenu = class(TThemeBasic) Button1: TThemeButton; @@ -549,7 +560,8 @@ type OptionsLyrics: TThemeOptionsLyrics; OptionsThemes: TThemeOptionsThemes; OptionsRecord: TThemeOptionsRecord; - //Menu + OptionsAdvanced: TThemeOptionsAdvanced; + //ScreenSong extensions SongMenu: TThemeSongMenu; SongJumpto: TThemeSongJumpTo; //Party Screens: @@ -633,6 +645,7 @@ begin OptionsLyrics := TThemeOptionsLyrics.Create; OptionsThemes := TThemeOptionsThemes.Create; OptionsRecord := TThemeOptionsRecord.Create; + OptionsAdvanced := TThemeOptionsAdvanced.Create; SongMenu := TThemeSongMenu.Create; SongJumpto := TThemeSongJumpto.Create; @@ -939,72 +952,74 @@ begin 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.ButtonExit, 'OptionsButtonExit'); - - {{$IFDEF TRANSLATE} - Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); - Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); - Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); - Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); - Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); - Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); - Options.Description[6] := Language.Translate('SING_OPTIONS_EXIT'); - {{$ENDIF} - - 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'); - //ThemeLoadSelect(OptionsSound.SelectTwoPlayerMode, 'OptionsSoundSelectTwoPlayerMode'); - ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); - - // Options Lyrics - ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); - - ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); - ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); - - // Options Themes - ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); + // 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'); + + {{$IFDEF TRANSLATE} + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); + Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED'); + Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); + {{$ENDIF} + + 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'); + //ThemeLoadSelect(OptionsSound.SelectTwoPlayerMode, 'OptionsSoundSelectTwoPlayerMode'); + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); + + // Options Themes + ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); @@ -1020,147 +1035,158 @@ begin ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); - //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'); + //Options Advanced + ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); + + ThemeLoadSelect (OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); + ThemeLoadSelect (OptionsAdvanced.SelectEffectPerfect, 'OptionsAdvancedSelectEffectPerfect'); + ThemeLoadSelect (OptionsAdvanced.SelectEffectGolden, 'OptionsAdvancedSelectEffectGolden'); + ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); + ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); + ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); + + //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'); + + ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); + ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); + ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); + + ThemeLoadButton (PartyNewRound.ButtonNext, 'PartyNewRoundButtonNext'); + + //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.StaticTeam2, 'PartyScoreStaticTeam2'); + ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); + + 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.StaticTeam2, 'PartyWinStaticTeam2'); + ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); + + 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');} + + //Playlist Translations + Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT') + end; - //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'); - - ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); - ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); - ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); - - ThemeLoadButton (PartyNewRound.ButtonNext, 'PartyNewRoundButtonNext'); - - //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.StaticTeam2, 'PartyScoreStaticTeam2'); - ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); - - 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.StaticTeam2, 'PartyWinStaticTeam2'); - ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); - - 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');} - - //Playlist Translations - Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT') - end; - ThemeIni.Free; end; end; -- cgit v1.2.3 From 4f7bf28056fefdcd000499c583a47738ce7d9b07 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 6 Apr 2007 10:32:24 +0000 Subject: Fixed a Bug in Optionsscreen after adding OptionsAdvanced Screen Added Jump to Title HotKey (Alt + A..Z) Added Playlist Support to Party Mode, Category Only Mode is still buggy. Fixed: Team3 Players are now Hidden when only 2 Teams are Selected git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@67 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 585f9271..a6207c4f 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -50,8 +50,8 @@ type {Modes: 0: Standard Mode - 1: PlayList Mode - 2: Category Mode} + 1: Category Mode + 2: PlayList Mode} var PlayListMan: TPlaylistManager; @@ -244,7 +244,7 @@ begin //Set CatSongsMode + Playlist Mode CatSongs.CatNumShow := -3; - Mode := 1; + Mode := 2; //Show Cat in Topleft: ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); -- cgit v1.2.3 From ce1d554d8084e549beb20f01c8315b44adff5f3a Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 6 Apr 2007 10:50:31 +0000 Subject: Changed Osci/Bar Standard Value to Bar So the Rating bar is Visible at first Startup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@68 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 7ab8de99..d5589ea3 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -259,7 +259,7 @@ begin if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; // Oscilloscope - Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Off'); + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); for Pet := 0 to High(IOscilloscope) do if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; -- cgit v1.2.3 From 455c6240e52f751dd7eab10620cecb9fc1711429 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 6 Apr 2007 12:33:21 +0000 Subject: Added Coolie Hat Support to UJoystick Added Axis Support to UJoystick Remapped Buttons git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@69 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UJoystick.pas | 169 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 159 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UJoystick.pas b/Game/Code/Classes/UJoystick.pas index a2a06307..b0c7b8cc 100644 --- a/Game/Code/Classes/UJoystick.pas +++ b/Game/Code/Classes/UJoystick.pas @@ -12,8 +12,17 @@ type 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 @@ -29,7 +38,7 @@ var implementation -uses SysUtils; +uses SysUtils, Windows, ULog; constructor TJoy.Create; var @@ -77,13 +86,21 @@ begin //New Sarutas method SDL_JoystickEventState(SDL_IGNORE); SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks < 1 then beep; + if SDL_NumJoysticks < 1 then + begin + Log.LogError('No Joystick found'); + exit; + end; - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then beep; + 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 beep; + //if N < 6 then beep; for B := 0 to 5 do begin JoyUnit.Button[B].Enabled := true; @@ -91,21 +108,37 @@ begin JoyUnit.Button[B].Type_ := SDL_KEYDOWN; end; - JoyUnit.Button[0].Sym := SDLK_UP; - JoyUnit.Button[1].Sym := SDLK_RIGHT; - JoyUnit.Button[2].Sym := SDLK_DOWN; - JoyUnit.Button[3].Sym := SDLK_LEFT; + 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; + 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_; @@ -119,6 +152,122 @@ begin JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B); end; + //Get Tick + Tick := Gettickcount; + + //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. -- cgit v1.2.3 From dd97441dc46eb52b124edf4e0a2ba6a650867e8e Mon Sep 17 00:00:00 2001 From: mogguh Date: Fri, 6 Apr 2007 17:41:55 +0000 Subject: Feature: Golden notes twinkle now when hit (Bug: if singing is stopped while note was hit (i.e. singer not singing loud enough), then twinkle will not be killed) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@70 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 5 +++++ Game/Code/Classes/UGraphic.pas | 2 +- Game/Code/Classes/UGraphicClasses.pas | 41 ++++++++++++++++++++++++++++++++--- 3 files changed, 44 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index e0e8e941..7447b6bf 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -425,6 +425,11 @@ var end; // with end; // for +// eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit +// singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + with Player[NrGracza].Nuta[N] do + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right); end; // if end; diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 73bb1706..9f3e6667 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -191,7 +191,7 @@ begin end; Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')), 'JPG', 'Font Black', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index d5eb44ab..66264334 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -30,6 +30,7 @@ type LastTime : Cardinal; RecArray : Array of RectanglePositions; PerfNoteArray : Array of PerfectNotePositions; + DelayAfterKillall : Integer; constructor Create; procedure Draw; @@ -39,6 +40,7 @@ type procedure KillAll(); procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); procedure SavePerfectNotePos(Xtop, Ytop: Real); + procedure GoldenNoteTwinkle(Top,Bottom,Right: Real); end; var GoldenRec : TEffectManager; @@ -64,27 +66,36 @@ var W, H: real; Alpha : real; begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); //Fade Eyecandy + //Fade Eyecandy Case StarType of 1: begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); W := 20; H := 20; glColor4f(0.99, 1, 0.6, Alpha); end; 2: begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); W := 30; H := 30; glColor4f(1, 1, 0.95, Alpha); end; + 3: + begin + Alpha := (Live/3); + W := 15; + H := 15; + glColor4f(1, 1, 0.9, Alpha); + end; end; + glBindTexture(GL_TEXTURE_2D, Tex); glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex); + glEnable(GL_BLEND); begin glBegin(GL_QUADS); @@ -211,6 +222,30 @@ begin SetLength(PerfNoteArray,0); end; +procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real); +//Twinkle stars while golden note hit +var + C, P, XKatze, YKatze: Integer; +begin + DelayAfterKillall:=10; // To be used later, for the screen change issue + For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + begin + if ((RecArray[P].xBottom >= Right) and + (RecArray[P].xTop <= Right) and + (RecArray[P].yTop <= (Top+Bottom)/2) and + (RecArray[P].yBottom >= (Top+Bottom)/2)) then + begin + for C := 1 to 8 do + begin + Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); + XKatze := RandomRange(-7,3); + Spawn(Ceil(Right)+XKatze, YKatze, Tex_Note_Star.TexNum, 3, 0, -1, 3); + end; + exit; // found a GoldenRec, did spawning stuff... done + end; + end; +end; + procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); var P : Integer; // P like used in Positions -- cgit v1.2.3 From 4ce8b89fdaf829546449c0d1acab14df80c49d95 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 7 Apr 2007 12:58:11 +0000 Subject: Fixed some Bugs in Effect Engine: Perfect Note Stars was drawn 2 Times Golden Note Extra twinkling stops and is redrawn until next Sentece or Note at the End of the Golden Note. Redrawing of Golden Note Twinkles at the next Sentence git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@71 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 11 ++-- Game/Code/Classes/UGraphicClasses.pas | 99 ++++++++++++++++++++++++----------- 2 files changed, 74 insertions(+), 36 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 7447b6bf..952bad07 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -425,11 +425,12 @@ var end; // with end; // for -// eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit -// singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ - with Player[NrGracza].Nuta[N] do - if not (Start+Dlugosc-1 = Czas.AktBeatD) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right); + // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit + // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + + // passing on NrGracza... hope this is really something like the player-number, not only + // some kind of weird index into a colour-table + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); end; // if end; diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 66264334..34a964b2 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -29,8 +29,9 @@ type Particle : array of TParticle; LastTime : Cardinal; RecArray : Array of RectanglePositions; + TwinkleArray : Array[0..5] of PerfectNotePositions; // store position of last twinkle for every player PerfNoteArray : Array of PerfectNotePositions; - DelayAfterKillall : Integer; + KillallTime : Cardinal; // Timestamp set when Killall is called constructor Create; procedure Draw; @@ -40,7 +41,7 @@ type procedure KillAll(); procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); procedure SavePerfectNotePos(Xtop, Ytop: Real); - procedure GoldenNoteTwinkle(Top,Bottom,Right: Real); + procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); end; var GoldenRec : TEffectManager; @@ -48,6 +49,10 @@ var GoldenRec : TEffectManager; implementation uses sysutils, Windows,OpenGl12, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; +const + KillallDelay: Integer = 100; + + //TParticle Constructor TParticle.Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : Integer); begin @@ -111,8 +116,15 @@ end; constructor TEffectManager.Create; +var c: Cardinal; begin LastTime := GetTickCount; + KillallTime := LastTime; + for c:=0 to 5 do + begin + TwinkleArray[c].xPos := 0; + TwinkleArray[c].yPos := 0; + end; end; @@ -214,27 +226,41 @@ if not(LastParticleIndex = -1) then end; procedure TEffectManager.KillAll(); +var c: Cardinal; begin //It's the kill all kennies rotuine while Length(Particle) > 0 do Kill(0); SetLength(RecArray,0); SetLength(PerfNoteArray,0); + for c:=0 to 5 do + begin + TwinkleArray[c].xPos:=0; + TwinkleArray[c].yPos:=0; + end; end; -procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real); +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: Integer; + CurrentTime: Cardinal; begin - DelayAfterKillall:=10; // To be used later, for the screen change issue - For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? - begin - if ((RecArray[P].xBottom >= Right) and - (RecArray[P].xTop <= Right) and - (RecArray[P].yTop <= (Top+Bottom)/2) and - (RecArray[P].yBottom >= (Top+Bottom)/2)) then + CurrentTime := GetTickCount; + //delay after Killall + if (CurrentTime > (KillallTime + KillallDelay)) then + // make sure we spawn only one time at one position + if (TwinkleArray[Player].xPos < Right) then + For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + begin + if ((RecArray[P].xBottom >= Right) and + (RecArray[P].xTop <= Right) and + (RecArray[P].yTop <= (Top+Bottom)/2) and + (RecArray[P].yBottom >= (Top+Bottom)/2)) then begin + TwinkleArray[Player].xPos:=Right; + for C := 1 to 8 do begin Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); @@ -243,21 +269,26 @@ begin end; exit; // found a GoldenRec, did spawning stuff... done end; - end; + end; end; procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); var P : Integer; // P like used in Positions NewIndex : Integer; + CurrentTime: Cardinal; 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))) then - exit; // it's already in the array, so we don't have to create a new one - end; + CurrentTime := GetTickCount; + //delay after Killall + if (CurrentTime > (KillallTime + KillallDelay)) then + 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))) 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 + // we got a new position, add the new positions to our array NewIndex := Length(RecArray); SetLength(RecArray, NewIndex + 1); RecArray[NewIndex].xTop := Xtop; @@ -266,6 +297,7 @@ begin RecArray[NewIndex].yBottom := Ybottom; RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3; RecArray[NewIndex].CurrentStarCount := 0; + end; end; procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); @@ -275,27 +307,32 @@ var RandomFrame : Integer; Xkatze, Ykatze : Integer; + CurrentTime: Cardinal; begin - For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? - begin - if ((ceil(PerfNoteArray[P].xPos) = ceil(Xtop)) and (ceil(PerfNoteArray[P].yPos) = ceil(Ytop))) then - exit; // it's already in the array, so we don't have to create a new one - end; + CurrentTime := GetTickCount; + //delay after Killall + if (CurrentTime > (KillallTime + KillallDelay)) then + begin + For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? + begin + if ((ceil(PerfNoteArray[P].xPos) = ceil(Xtop)) and (ceil(PerfNoteArray[P].yPos) = ceil(Ytop))) 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 + // 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; - 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, Tex_Note_Perfect_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); - end; - + 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, Tex_Note_Perfect_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); + end; + end; end; end. -- cgit v1.2.3 From 80e691699f2b236e4af80f8c1178cde07b458da3 Mon Sep 17 00:00:00 2001 From: mogguh Date: Wed, 11 Apr 2007 14:10:41 +0000 Subject: Feature: ScoreScreen now has the ability to show extra texts (UThemes.pas, UScreenScore.pas) Feature: Hit golden note effect, is now even more astonishing (UGraphicClasses.pas) Feature: It's now possible to turn of GoldenNoteTwinkle (UDraw.pas) BugFix: OptionsAdvanced is now opened correctly, instead of producing a bug (UGraphic.pas) BugFix: Modified some language entries to fit option screen (optionen instead of einstellungen) (German.ini) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@78 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2 + Game/Code/Classes/UGraphic.pas | 2 +- Game/Code/Classes/UGraphicClasses.pas | 362 +++++++++++++++++++++------------- Game/Code/Classes/UThemes.pas | 5 + 4 files changed, 233 insertions(+), 138 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 952bad07..e2c01b4b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -430,6 +430,8 @@ var // passing on NrGracza... hope this is really something like the player-number, not only // some kind of weird index into a colour-table + + if (Ini.EffectGolden=1) then GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); end; // if end; diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 9f3e6667..c3ce0f00 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -404,7 +404,7 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); ScreenOptionsRecord := TScreenOptionsRecord.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); ScreenEditSub := TScreenEditSub.Create(''); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 34a964b2..5fa22575 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -1,18 +1,30 @@ unit UGraphicClasses; interface - +const DelayBetweenFrames : Cardinal = 100; type + + TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle); + + TColour3f = Record + r, g, b: Real; + end; + TParticle = Class X, Y : Real; //Position + W, H : Cardinal; //dimensions of particle + Col : TColour3f; // Colour of particle 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 - StarType : Integer; // 1: GoldenNote | 2: PerfectNote + 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 - Constructor Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : Integer); + Constructor Create(cX,cY: Real; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); procedure Draw; + procedure LiveOn; end; RectanglePositions = Record @@ -29,13 +41,19 @@ type Particle : array of TParticle; LastTime : Cardinal; RecArray : Array of RectanglePositions; - TwinkleArray : Array[0..5] of PerfectNotePositions; // store position of last twinkle for every player + TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player PerfNoteArray : Array of PerfectNotePositions; - KillallTime : Cardinal; // Timestamp set when Killall is called constructor Create; + destructor Destroy; override; procedure Draw; - function Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : Integer): Cardinal; + function Spawn(X, Y: Real; + 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(); @@ -49,53 +67,109 @@ var GoldenRec : TEffectManager; implementation uses sysutils, Windows,OpenGl12, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; -const - KillallDelay: Integer = 100; - - //TParticle -Constructor TParticle.Create(cX,cY: Real; cTex: Cardinal; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : Integer); +Constructor TParticle.Create(cX,cY: Real; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); begin + inherited Create; X := cX; Y := cY; - Tex := cTex; Live := cLive; Frame:= cFrame; RecIndex := cRecArrayIndex; StarType := cStarType; -end; - - -procedure TParticle.Draw; -var - W, H: real; - Alpha : real; -begin - //Fade Eyecandy - - Case StarType of - 1: + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + case cStarType of + GoldenNote: begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); + Tex := Tex_Note_Star.TexNum; W := 20; H := 20; - glColor4f(0.99, 1, 0.6, Alpha); + Col.r := 0.99; + Col.g := 1; + Col.b := 0.6; end; - 2: + PerfectNote: begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); + Tex := Tex_Note_Perfect_Star.TexNum; W := 30; H := 30; - glColor4f(1, 1, 0.95, Alpha); + Col.r := 1; + Col.g := 1; + Col.b := 0.95; end; - 3: + NoteHitTwinkle: begin - Alpha := (Live/3); + Tex := Tex_Note_Star.TexNum; + Alpha := (Live/10); // linear fade-out W := 15; H := 15; - glColor4f(1, 1, 0.9, Alpha); + Col.r := 1; + Col.g := 1; + Col.b := RandomRange(10*Live,100)/80; //0.9; + end; + PerfectLineTwinkle: + begin + Tex := Tex_Note_Star.TexNum; + W := RandomRange(10,30); + H := W; + // hier muss entsprechend des players farbe gesetzt werden (sollten wir dann auch übergeben bekommen) + // case Player of + // ... + Col.r := 1; + Col.g := 0.5; + Col.b := 0.5; + mX := RandomRange(-5,5); + mY := RandomRange(-5,5); + end; + else // just some random default values + begin + Tex := Tex_Note_Star.TexNum; + Alpha := 1; + W := 20; + H := 20; + Col.r := 1; + Col.g := 1; + Col.b := 1; end; end; +end; + +procedure TParticle.LiveOn; +begin + //Live = 0 => Live forever ?? die werden doch aber im Manager bei Draw getötet, wenns 0 is + if (Live > 0) then + Dec(Live); + + // animate frames + Frame := ( Frame + 1 ) mod 16; + + // make our particles do funny stuff (besides being animated) + 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 + // move around + X := X + mX; + Y := Y + mY; + end; + end; +end; + +procedure TParticle.Draw; +begin + glColor4f(Col.r, Col.g, Col.b, Alpha); glBindTexture(GL_TEXTURE_2D, Tex); glEnable(GL_TEXTURE_2D); @@ -112,44 +186,43 @@ begin end; glcolor4f(1,1,1,1); end; +// end of TParticle - +// TEffectManager constructor TEffectManager.Create; var c: Cardinal; begin + inherited; LastTime := GetTickCount; - KillallTime := LastTime; for c:=0 to 5 do begin - TwinkleArray[c].xPos := 0; - TwinkleArray[c].yPos := 0; + TwinkleArray[c] := 0; end; end; +destructor TEffectManager.Destroy; +begin + Killall; + inherited; +end; + procedure TEffectManager.Draw; var I: Integer; CurrentTime: Cardinal; -const - DelayBetweenFrames : Integer = 100; +//const +// DelayBetweenFrames : Cardinal = 100; begin CurrentTime := GetTickCount; //Manage particle life - if (CurrentTime > (LastTime + DelayBetweenFrames)) then + if (CurrentTime - LastTime) > DelayBetweenFrames then begin LastTime := CurrentTime; - for I := 0 to high(Particle) do - begin - Particle[I].Frame := (Particle[I].Frame + 1 ) mod 16; - //Live = 0 => Live forever - if (Particle[I].Live > 0) then - begin - Dec(Particle[I].Live); - end; - end; + for I := 0 to high(Particle) do + Particle[I].LiveOn; end; I := 0; @@ -173,15 +246,15 @@ begin end; end; - -function TEffectManager.Spawn(X, Y: Real; Tex: Cardinal; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : Integer): Cardinal; +// this method creates just one particle +function TEffectManager.Spawn(X, Y: Real; 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, Tex, Live, StartFrame, RecArrayIndex, StarType); + Particle[Result] := TParticle.Create(X, Y, Live, StartFrame, RecArrayIndex, StarType, Player); end; - +// manage Sparkling of GoldenNote Bars procedure TEffectManager.SpawnRec(); Var Xkatze, Ykatze : Real; @@ -197,46 +270,46 @@ for P:= 0 to high(RecArray) do 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(Xkatze, Ykatze, Tex_Note_Star.TexNum, 16 - RandomFrame, RandomFrame, P, 1); + // Spawn a GoldenNote Particle + Spawn(Xkatze, Ykatze, 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 : Cardinal; + LastParticleIndex : Integer; begin -// We put the last element of the array on the place where our element_to_delete resides and then we shorten the array - cool, hu? :P - -LastParticleIndex := high(Particle); -if not(LastParticleIndex = -1) then +// 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 - Try - Finally - if not(Particle[Index].RecIndex = -1) then - dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); - Particle[Index].Destroy; - Particle[Index] := Particle[LastParticleIndex]; - SetLength(Particle, LastParticleIndex); - end; - end; + 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 + while Length(Particle) > 0 do // kill all existing particles Kill(0); - SetLength(RecArray,0); - SetLength(PerfNoteArray,0); + SetLength(RecArray,0); // remove GoldenRec positions + SetLength(PerfNoteArray,0); // remove PerfectNote positions for c:=0 to 5 do begin - TwinkleArray[c].xPos:=0; - TwinkleArray[c].yPos:=0; + TwinkleArray[c] := 0; // reset GoldenNoteHit memory end; end; @@ -244,95 +317,110 @@ procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integ //Twinkle stars while golden note hit // this is called from UDraw.pas, SingDrawPlayerCzesc var - C, P, XKatze, YKatze: Integer; - CurrentTime: Cardinal; + C, P, XKatze, YKatze, LKatze: Integer; + H: Real; begin - CurrentTime := GetTickCount; - //delay after Killall - if (CurrentTime > (KillallTime + KillallDelay)) then - // make sure we spawn only one time at one position - if (TwinkleArray[Player].xPos < Right) then - For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + // 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)) then begin - if ((RecArray[P].xBottom >= Right) and - (RecArray[P].xTop <= Right) and - (RecArray[P].yTop <= (Top+Bottom)/2) and - (RecArray[P].yBottom >= (Top+Bottom)/2)) then + TwinkleArray[Player] := Right; // remember twinkle position for this player + for C := 1 to 20 do begin - TwinkleArray[Player].xPos:=Right; - - for C := 1 to 8 do - begin - Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); - XKatze := RandomRange(-7,3); - Spawn(Ceil(Right)+XKatze, YKatze, Tex_Note_Star.TexNum, 3, 0, -1, 3); - end; - exit; // found a GoldenRec, did spawning stuff... done + Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); + XKatze := RandomRange(-7,3); + LKatze := RandomRange(4,10); + Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); end; + for C := 1 to 5 do + begin + Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(2,3); + Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 5 do + begin + Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(2,3); + Spawn(Ceil(Right)+XKatze, YKatze, 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,2); + Spawn(Ceil(Right)+XKatze, YKatze, 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,2); + Spawn(Ceil(Right)+XKatze, YKatze, 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; - CurrentTime: Cardinal; begin - CurrentTime := GetTickCount; - //delay after Killall - if (CurrentTime > (KillallTime + KillallDelay)) then - 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))) then - exit; // it's already in the array, so we don't have to create a new one - end; + 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))) 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; - end; + 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; end; procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); var P : Integer; // P like used in Positions NewIndex : Integer; - RandomFrame : Integer; Xkatze, Ykatze : Integer; - CurrentTime: Cardinal; begin - CurrentTime := GetTickCount; - //delay after Killall - if (CurrentTime > (KillallTime + KillallDelay)) then - begin - For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? - begin - if ((ceil(PerfNoteArray[P].xPos) = ceil(Xtop)) and (ceil(PerfNoteArray[P].yPos) = ceil(Ytop))) then - exit; // it's already in the array, so we don't have to create a new one - end; + 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))) 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; + NewIndex := Length(PerfNoteArray); + SetLength(PerfNoteArray, NewIndex + 1); + PerfNoteArray[NewIndex].xPos := Xtop; + PerfNoteArray[NewIndex].yPos := Ytop; - 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, Tex_Note_Perfect_Star.TexNum, 16 - RandomFrame, RandomFrame, -1, 2); - end; - end; + 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, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); + end; //for end; + end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 17983a60..d7adb61a 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -290,7 +290,10 @@ type 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; @@ -917,9 +920,11 @@ begin 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)); -- cgit v1.2.3 From 943d001a21095f936fdcfc58f11cdbd6d30578a5 Mon Sep 17 00:00:00 2001 From: b1indy Date: Wed, 11 Apr 2007 20:22:01 +0000 Subject: first implementation of perfect line twinkle effect - works correctly for up to 3 players, restructured parts of particle code git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@80 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 196 ++++++++++++++++++++++++++++------ Game/Code/Classes/UMain.pas | 4 +- 2 files changed, 167 insertions(+), 33 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 5fa22575..6f2aa0e4 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -1,3 +1,4 @@ +// notes: unit UGraphicClasses; interface @@ -13,7 +14,8 @@ type TParticle = Class X, Y : Real; //Position W, H : Cardinal; //dimensions of particle - Col : TColour3f; // Colour 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 @@ -21,8 +23,10 @@ type StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle Alpha : Real; // used for fading... mX, mY : Real; // movement-vector for PerfectLineTwinkle + SurviveSentenceChange : Boolean; Constructor Create(cX,cY: Real; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); + Destructor Destroy(); procedure Draw; procedure LiveOn; end; @@ -57,20 +61,23 @@ type 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, Windows,OpenGl12, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; +uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; //TParticle Constructor TParticle.Create(cX,cY: Real; 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; Live := cLive; @@ -78,24 +85,45 @@ begin 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; case cStarType of GoldenNote: begin Tex := Tex_Note_Star.TexNum; W := 20; H := 20; - Col.r := 0.99; - Col.g := 1; - Col.b := 0.6; + 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; - Col.r := 1; - Col.g := 1; - Col.b := 0.95; + SetLength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := 0.95; end; NoteHitTwinkle: begin @@ -103,21 +131,33 @@ begin Alpha := (Live/10); // linear fade-out W := 15; H := 15; - Col.r := 1; - Col.g := 1; - Col.b := RandomRange(10*Live,100)/80; //0.9; + Setlength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := RandomRange(10*Live,100)/80; //0.9; end; PerfectLineTwinkle: begin Tex := Tex_Note_Star.TexNum; W := RandomRange(10,30); H := W; - // hier muss entsprechend des players farbe gesetzt werden (sollten wir dann auch übergeben bekommen) - // case Player of - // ... - Col.r := 1; - Col.g := 0.5; - Col.b := 0.5; + SurviveSentenceChange:=True; + // assign colours according to player given + SetLength(Scale,2); + Scale[1]:=0.3; + SetLength(Col,2); + 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:=Col[0].r+0.5; + Col[1].g:=Col[0].g+0.5; + Col[1].b:=Col[0].b+0.5; mX := RandomRange(-5,5); mY := RandomRange(-5,5); end; @@ -127,13 +167,21 @@ begin Alpha := 1; W := 20; H := 20; - Col.r := 1; - Col.g := 1; - Col.b := 1; + 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 ?? die werden doch aber im Manager bei Draw getötet, wenns 0 is @@ -144,6 +192,7 @@ begin 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 @@ -168,21 +217,26 @@ begin end; procedure TParticle.Draw; +var L: Cardinal; begin - glColor4f(Col.r, Col.g, Col.b, Alpha); + // 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); + 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, Y-H); - glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W, Y+H); - glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W, Y+H); - glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W, Y-H); - glEnd; + begin + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L], Y-H*Scale[L]); + glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L], Y+H*Scale[L]); + glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L], Y+H*Scale[L]); + glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L], Y-H*Scale[L]); + glEnd; + end; end; glcolor4f(1,1,1,1); end; @@ -313,6 +367,25 @@ begin 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 @@ -420,6 +493,65 @@ begin RandomFrame := RandomRange(0,14); Spawn(Xkatze, Ykatze, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); end; //for + +end; + +procedure TEffectManager.SpawnPerfectLineTwinkle(); +var + P,I,Life: Cardinal; + Left, Right, Top, Bottom: Cardinal; +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; + end; + 2,4: 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; + 3,6: 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; + 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), Life, 16-Life, -1, PerfectLineTwinkle, P); + end; + end; end; end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index f92b9457..3b6be56e 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -40,7 +40,9 @@ type LineBonus_StartY: integer; //PhrasenBonus - Line Bonus Mod End - + //PerfectLineTwinkle Mod (effect) + LastSentencePerfect: Boolean; + //PerfectLineTwinkle Mod end // Meter: real; -- cgit v1.2.3 From c3e4fa819306ebe07686ce448283cd9a18c262a9 Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 12 Apr 2007 11:00:12 +0000 Subject: fixed bug in particle system that caused effects to be drawn on both screens when playing in dual screen mode, fixed position and particle counts of some effects, changed look of particles git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@81 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 180 ++++++++++++++++++++-------------- 1 file changed, 107 insertions(+), 73 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 6f2aa0e4..acc26e96 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -2,7 +2,7 @@ unit UGraphicClasses; interface -const DelayBetweenFrames : Cardinal = 100; +const DelayBetweenFrames : Cardinal = 60; type TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle); @@ -13,6 +13,7 @@ type 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 @@ -23,9 +24,10 @@ type 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; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); + Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); Destructor Destroy(); procedure Draw; procedure LiveOn; @@ -35,10 +37,12 @@ type xTop, yTop, xBottom, yBottom : Real; TotalStarCount : Integer; CurrentStarCount : Integer; + Screen : Integer; end; PerfectNotePositions = Record xPos, yPos : Real; + Screen : Integer; end; TEffectManager = Class @@ -52,6 +56,7 @@ type destructor Destroy; override; procedure Draw; function Spawn(X, Y: Real; + Screen: Integer; Live: Byte; StartFrame: Integer; RecArrayIndex: Integer; // this is only used with GoldenNotes @@ -74,20 +79,22 @@ implementation uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; //TParticle -Constructor TParticle.Create(cX,cY: Real; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); +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; + Scale[0] := 1; + SurviveSentenceChange := False; + SizeMod := 1; case cStarType of GoldenNote: begin @@ -128,24 +135,26 @@ begin NoteHitTwinkle: begin Tex := Tex_Note_Star.TexNum; - Alpha := (Live/10); // linear fade-out + 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)/80; //0.9; + Col[0].b := RandomRange(10*Live,100)/90; //0.9; end; PerfectLineTwinkle: begin Tex := Tex_Note_Star.TexNum; - W := RandomRange(10,30); + 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,2); + SetLength(Scale,3); Scale[1]:=0.3; - SetLength(Col,2); + 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'); @@ -155,9 +164,12 @@ begin 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:=Col[0].r+0.5; - Col[1].g:=Col[0].g+0.5; - Col[1].b:=Col[0].b+0.5; + 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; @@ -209,6 +221,7 @@ begin 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; @@ -219,25 +232,26 @@ end; procedure TParticle.Draw; var L: Cardinal; begin - // 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); + 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); + 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], Y-H*Scale[L]); - glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L], Y+H*Scale[L]); - glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L], Y+H*Scale[L]); - glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L], Y-H*Scale[L]); - glEnd; + 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; - end; glcolor4f(1,1,1,1); end; // end of TParticle @@ -301,11 +315,11 @@ begin end; // this method creates just one particle -function TEffectManager.Spawn(X, Y: Real; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal; +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, Live, StartFrame, RecArrayIndex, StarType, Player); + Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player); end; // manage Sparkling of GoldenNote Bars @@ -325,7 +339,7 @@ for P:= 0 to high(RecArray) do Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); RandomFrame := RandomRange(0,14); // Spawn a GoldenNote Particle - Spawn(Xkatze, Ykatze, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); + Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); inc(RecArray[P].CurrentStarCount); end; end; @@ -400,43 +414,44 @@ begin H := (Top+Bottom)/2; // helper... with RecArray[P] do if ((xBottom >= Right) and (xTop <= Right) and - (yTop <= H) and (yBottom >= H)) then + (yTop <= H) and (yBottom >= H)) + and (Screen = ScreenAct) then begin TwinkleArray[Player] := Right; // remember twinkle position for this player - for C := 1 to 20 do + for C := 1 to 10 do begin Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); XKatze := RandomRange(-7,3); - LKatze := RandomRange(4,10); - Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + LKatze := RandomRange(7,13); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); end; - for C := 1 to 5 do + for C := 1 to 3 do begin Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); XKatze := RandomRange(-5,1); - LKatze := RandomRange(2,3); - Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + LKatze := RandomRange(4,7); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); end; - for C := 1 to 5 do + for C := 1 to 3 do begin Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); XKatze := RandomRange(-5,1); - LKatze := RandomRange(2,3); - Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + 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,2); - Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + 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,2); - Spawn(Ceil(Right)+XKatze, YKatze, LKatze, 0, -1, NoteHitTwinkle, 0); + 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 @@ -451,7 +466,9 @@ var 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))) then + 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; @@ -464,6 +481,7 @@ begin 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); @@ -476,7 +494,8 @@ 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))) then + 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 @@ -485,13 +504,14 @@ begin 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, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); + Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); end; //for end; @@ -500,6 +520,7 @@ 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 @@ -517,39 +538,52 @@ begin // calculate area where notes of this player are drawn case PlayersPlay of 1: begin - Bottom:=Skin_P2_NotesB-10; + Bottom:=Skin_P2_NotesB; Top:=Bottom-105; + cScreen:=1; end; - 2,4: 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; + 2,4: begin + case P of + 0,2: begin + Bottom:=Skin_P1_NotesB; + Top:=Bottom-105; + end; + else begin + Bottom:=Skin_P2_NotesB; + Top:=Bottom-105; + end; + end; + case P of + 0,1: cScreen:=1; + else cScreen:=2; + end; end; - 3,6: 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; + 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), Life, 16-Life, -1, PerfectLineTwinkle, P); + Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); end; end; end; -- cgit v1.2.3 From e6917faa19aebfa6d089b24c65e4c7fe4bd6b503 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 13 Apr 2007 11:25:13 +0000 Subject: Added Reflection to ThemeStatic Added Attribut ReflectionSpacing git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@83 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index d7adb61a..51b454ca 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -91,6 +91,9 @@ type TexY1: real; TexX2: real; TexY2: real; + //Reflection Mod + Reflection: boolean; + Reflectionspacing: Real; end; AThemeStatic = array of TThemeStatic; @@ -129,7 +132,8 @@ type Tex: string; Typ: string; //Reflection Mod - Reflection: Boolean; + Reflection: boolean; + Reflectionspacing: Real; end; TThemeSelect = record @@ -181,6 +185,8 @@ type end; TThemeLoading = class(TThemeBasic) + StaticAnimation: TThemeStatic; + TextLoading: TThemeText; end; TThemeMain = class(TThemeBasic) @@ -749,6 +755,8 @@ begin // Loading ThemeLoadBasic(Loading, 'Loading'); + ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading'); + ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation'); // Main ThemeLoadBasic(Main, 'Main'); @@ -1284,6 +1292,10 @@ begin 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); + DecimalSeparator := ','; end; @@ -1317,6 +1329,7 @@ begin //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); -- cgit v1.2.3 From b1e40ba133782a3d36ec78d4cf9c0245b88448d1 Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 13 Apr 2007 22:17:48 +0000 Subject: implemented fading between screens (needs to be tested), minor tweaking of perfect-line effect position, added myself to credits ;) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@86 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index acc26e96..e1cd8aff 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -538,18 +538,18 @@ begin // calculate area where notes of this player are drawn case PlayersPlay of 1: begin - Bottom:=Skin_P2_NotesB; + Bottom:=Skin_P2_NotesB+10; Top:=Bottom-105; cScreen:=1; end; 2,4: begin case P of 0,2: begin - Bottom:=Skin_P1_NotesB; + Bottom:=Skin_P1_NotesB+10; Top:=Bottom-105; end; else begin - Bottom:=Skin_P2_NotesB; + Bottom:=Skin_P2_NotesB+10; Top:=Bottom-105; end; end; -- cgit v1.2.3 From 1fcd567446dce6e5e02d802e26cf38a538092cf3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 14 Apr 2007 16:54:30 +0000 Subject: Did Some Code Cleanup Fixed some Bugs in Party Mode Added a Better Round Plugin Selection git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@89 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 120 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 105 insertions(+), 15 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index da89ca8a..f5834dd8 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -22,7 +22,7 @@ type constructor Create; - procedure StartNewParty; + procedure StartNewParty(NumRounds: Byte); procedure StartRound; procedure EndRound; function GetWinner: Byte; @@ -47,14 +47,98 @@ end; //---------- //StartNewParty - Clears the Class and Prepares for new Party //---------- -procedure TParty_Session.StartNewParty; +procedure TParty_Session.StartNewParty(NumRounds: Byte); +var + Plugins: Array of record + ID: Byte; + TimesPlayed: Byte; + end; + TeamMode: Boolean; + Len: Integer; + I: Integer; + + function GetRandomPlugin: Byte; + var + LowestTP: Byte; + NumPwithLTP: Word; + I: Integer; + R: Word; + begin + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Plugins not often played yet + For I := 0 to high(Plugins) do + begin + if (Plugins[I].TimesPlayed < lowestTP) then + begin + lowestTP := Plugins[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Plugins[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Plugin + For I := 0 to high(Plugins) do + begin + if Plugins[I].TimesPlayed = lowestTP then + begin + //Plugin Found + if (R = 0) then + begin + Result := Plugins[I].ID; + Inc(Plugins[I].TimesPlayed); + Break; + end; + + Dec(R); + end; + end; + end; begin -//Set cur Round to Round 1 -CurRound := 255; + //Set cur Round to Round 1 + CurRound := 255; + + PlayersPlay := Teams.NumTeams; -PlayersPlay := Teams.NumTeams; -if isWinner(0,9) then - Log.LogError('Test'); + TeamMode := True; + For I := 0 to Teams.NumTeams-1 do + if Teams.Teaminfo[I].NumPlayers < 2 then + begin + TeamMode := False; + Break; + end; + + //Fill Plugin Array + SetLength(Plugins, 0); + For I := 0 to high(DLLMan.Plugins) do + begin + if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then + begin //Add only Plugins Playable with cur. PlayerConfiguration + Len := Length(Plugins); + SetLength(Plugins, Len + 1); + Plugins[Len].ID := I; + Plugins[Len].TimesPlayed := 0; + end; + end; + + //Set Rounds + If (Length(Plugins) >= 1) then + begin + SetLength (Rounds, NumRounds); + For I := 0 to NumRounds-1 do + begin + PartySession.Rounds[I].Plugin := GetRandomPlugin; + PartySession.Rounds[I].Winner := 255; + end; + end + else SetLength (Rounds, 0); end; //---------- @@ -65,10 +149,10 @@ var I, J: Integer; lowestTP: Byte; begin - //Get lowest TP + //Get lowest TimesPlayed lowestTP := high(Byte); J := -1; - for I := 0 to Teams.Teaminfo[Team].NumPlayers do + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do begin if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then begin @@ -86,7 +170,7 @@ begin repeat Result := Random(Teams.Teaminfo[Team].NumPlayers); until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) - else //Else Select the one wth lowest TP + else //Else Select the one with lowest TP Result:= J; end; @@ -106,7 +190,7 @@ begin DllMan.LoadPlugin(Rounds[CurRound].Plugin); //Select Players - for I := 0 to Teams.NumTeams do + for I := 0 to Teams.NumTeams-1 do Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); //Set ScreenSingModie Variables @@ -142,7 +226,7 @@ procedure TParty_Session.GenScores; var I: Byte; begin - for I := 0 to Teams.NumTeams do + for I := 0 to Teams.NumTeams-1 do begin if isWinner(I, Rounds[CurRound].Winner) then Inc(Teams.Teaminfo[I].Score); @@ -159,12 +243,18 @@ var begin if (Rounds[Round].Winner = 0) then begin - Result := 'Nobody'; + Result := Language.Translate('PARTY_NOBODY'); + exit; + end; + + if (Rounds[Round].Winner = 255) then + begin + Result := Language.Translate('PARTY_NOTPLAYEDYET'); exit; end; SetLength(Winners, 0); - for I := 0 to Teams.NumTeams do + for I := 0 to Teams.NumTeams-1 do begin if isWinner(I, Rounds[Round].Winner) then begin @@ -188,7 +278,7 @@ begin GenScores; //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams do + For I := 0 to Teams.NumTeams-1 do Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[0].CurPlayer].TimesPlayed); end; -- cgit v1.2.3 From fae5839e8025f020638b4cd0583a9a992c5a7a1e Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 15 Apr 2007 11:05:10 +0000 Subject: Fixed some Bugs in Party Mode Fixed Support CategoryOnly Playlist Support git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@93 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index f5834dd8..e5252f82 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -107,13 +107,16 @@ begin PlayersPlay := Teams.NumTeams; + //Get Teammode and Set Joker TeamMode := True; For I := 0 to Teams.NumTeams-1 do + begin if Teams.Teaminfo[I].NumPlayers < 2 then begin TeamMode := False; - Break; end; + Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + end; //Fill Plugin Array SetLength(Plugins, 0); @@ -186,7 +189,7 @@ begin //Increase Current Round Inc (CurRound); - Rounds[CurRound].Winner := 0; + Rounds[CurRound].Winner := 255; DllMan.LoadPlugin(Rounds[CurRound].Plugin); //Select Players @@ -241,9 +244,13 @@ var Winners: Array of String; I: Integer; begin + Result := Language.Translate('PARTY_NOBODY'); + + if (Round > High(Rounds)) then + exit; + if (Rounds[Round].Winner = 0) then begin - Result := Language.Translate('PARTY_NOBODY'); exit; end; -- cgit v1.2.3 From e8b20046dd4c181ea9b45fb3908daef41746cff2 Mon Sep 17 00:00:00 2001 From: b1indy Date: Mon, 16 Apr 2007 22:10:47 +0000 Subject: Fixed bug in TSkin.onThemeChange that caused a crash git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@100 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USkins.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 6cd4a1db..67b0ae93 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -145,6 +145,7 @@ var S: integer; Name: String; begin + Ini.SkinNo:=0; SetLength(ISkin, 0); Name := Uppercase(ITheme[Ini.Theme]); for S := 0 to High(Skin) do -- cgit v1.2.3 From e8f259a1a37ce5cf10a79dc53e184d6af4e7b7d6 Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 17 Apr 2007 00:48:03 +0000 Subject: Changed aadvanced options to switch on/off sing-effects and screen-fading Changed Languages (english, german) and Theme (deluxe) to reflect these changes implemented checks for config values to make these things work as expected git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@101 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 11 +++++------ Game/Code/Classes/UIni.pas | 36 ++++++++++++++++++------------------ Game/Code/Classes/UThemes.pas | 8 ++++---- 3 files changed, 27 insertions(+), 28 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index e2c01b4b..7eaddac4 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -48,7 +48,7 @@ var StarfrG: integer; - + //SingBar Mod TickOld: cardinal; TickOld2:cardinal; @@ -216,7 +216,7 @@ begin if not FreeStyle then begin - if Ini.EffectGolden = 0 then + if Ini.EffectSing = 0 then // If Golden note Effect of then Change not Color begin case Wartosc of @@ -270,7 +270,7 @@ begin glEnd; // Golden Star Patch - if (Wartosc = 2) AND (Ini.EffectGolden=1) then + if (Wartosc = 2) AND (Ini.EffectSing=1) then begin GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); end; @@ -379,7 +379,7 @@ var //Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; //if (Start+Dlugosc-1 = Czas.AktBeatD) then - if Perfect and (Ini.EffectPerfect=1) then begin + if Perfect and (Ini.EffectSing=1) then begin // A := sqrt((1+sin(Music.Position * 3))/2); A := 1 - 2*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); if not (Start+Dlugosc-1 = Czas.AktBeatD) then @@ -387,7 +387,6 @@ var //Star animation counter //inc(Starfr); //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); { SingDrawStar(Rec.Left+2, Rec.Top+4, A);} end; @@ -431,7 +430,7 @@ var // passing on NrGracza... hope this is really something like the player-number, not only // some kind of weird index into a colour-table - if (Ini.EffectGolden=1) then + if (Ini.EffectSing=1) then GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); end; // if end; diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index d5589ea3..cafbc912 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -58,8 +58,8 @@ type // Advanced LoadAnimation: integer; - EffectPerfect: integer; - EffectGolden: integer; + EffectSing: integer; + ScreenFade: integer; AskbeforeDel: integer; OnSongClick: integer; LineBonus: integer; @@ -135,8 +135,8 @@ const // Advanced ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectPerfect: array[0..1] of string = ('Off', 'On'); - IEffectGolden: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array [0..1] of String =('Off', 'On'); IAskbeforeDel: array[0..1] of string = ('Off', 'On'); IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); @@ -430,15 +430,15 @@ begin for Pet := 0 to High(ILoadAnimation) do if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; - // EffectPerfect - Tekst := IniFile.ReadString('Advanced', 'EffectPerfect', 'On'); - for Pet := 0 to High(IEffectPerfect) do - if Tekst = IEffectPerfect[Pet] then Ini.EffectPerfect := Pet; + // ScreenFade + Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); + for Pet := 0 to High(IScreenFade) do + if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; - // EffectGolden - Tekst := IniFile.ReadString('Advanced', 'EffectGolden', 'On'); - for Pet := 0 to High(IEffectGolden) do - if Tekst = IEffectGolden[Pet] then Ini.EffectGolden := Pet; + // EffectSing + Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); + for Pet := 0 to High(IEffectSing) do + if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; // AskbeforeDel Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); @@ -618,13 +618,13 @@ begin Tekst := ILoadAnimation[Ini.LoadAnimation]; IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - //EffectPerfect - Tekst := IEffectPerfect[Ini.EffectPerfect]; - IniFile.WriteString('Advanced', 'EffectPerfect', Tekst); + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); - //EffectGolden - Tekst := IEffectGolden[Ini.EffectGolden]; - IniFile.WriteString('Advanced', 'EffectGolden', Tekst); + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); //AskbeforeDel Tekst := IAskbeforeDel[Ini.AskbeforeDel]; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 51b454ca..6837d17f 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -402,8 +402,8 @@ type TThemeOptionsAdvanced = class(TThemeBasic) SelectLoadAnimation: TThemeSelect; - SelectEffectPerfect: TThemeSelect; - SelectEffectGolden: TThemeSelect; + SelectEffectSing: TThemeSelect; + SelectScreenFade: TThemeSelect; SelectLineBonus: TThemeSelect; SelectAskbeforeDel: TThemeSelect; SelectOnSongClick: TThemeSelectSlide; @@ -1052,8 +1052,8 @@ begin ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); ThemeLoadSelect (OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); - ThemeLoadSelect (OptionsAdvanced.SelectEffectPerfect, 'OptionsAdvancedSelectEffectPerfect'); - ThemeLoadSelect (OptionsAdvanced.SelectEffectGolden, 'OptionsAdvancedSelectEffectGolden'); + ThemeLoadSelect (OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); + ThemeLoadSelect (OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); -- cgit v1.2.3 From a2539871abfbd2c50ef763350cc56fa5ef45f2d4 Mon Sep 17 00:00:00 2001 From: mota23 Date: Tue, 17 Apr 2007 13:33:35 +0000 Subject: Well, heres my first commit since R11. Some minor skin changes, new skin.ini-entry LyricHelpBar git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@102 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 27 ++++++++++++++++++++------- Game/Code/Classes/UGraphic.pas | 7 ++++--- 2 files changed, 24 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 7eaddac4..410fbb2e 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -663,24 +663,37 @@ begin Rec.Top := Skin_LyricsT + 3; Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3; - // zapalanie +{ // 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); + if BarWspol > 0.95 then BarAlpha := 0.5 * (1 - (BarWspol - 0.95) * 20);} + //Change fuer Crazy Joker - glEnable(GL_BLEND); - glBegin(GL_QUADS); + + 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(1/16, 1/16); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/16, 15/16); glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(1, 1, 1, 0.5); + glTexCoord2f(15/16, 15/16); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(15/16, 1/16); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glDisable(GL_BLEND); +{ glBegin(GL_QUADS); glColor4f(26/255, 165/255, 220/255, 0); glVertex2f(Rec.Left, Rec.Top); glVertex2f(Rec.Left, Rec.Bottom); glColor4f(26/255, 165/255, 220/255, BarAlpha); glVertex2f(Rec.Right, Rec.Bottom); glVertex2f(Rec.Right, Rec.Top); - glEnd; - glDisable(GL_BLEND); - end; + glEnd;} + end; // oscilloscope if Ini.Oscilloscope = 1 then begin diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index c3ce0f00..b909e49f 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -76,6 +76,7 @@ var Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; FullScreen: boolean; @@ -191,9 +192,9 @@ begin end; Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); //SingBar Mod -- cgit v1.2.3 From 033bd987a8d704aa7eb62e1cdd572694d3cd728d Mon Sep 17 00:00:00 2001 From: mogguh Date: Tue, 17 Apr 2007 16:09:34 +0000 Subject: Bugfix: Fixed minor problem that caused artefacts to be drawn - 'transparent' now works with #ffffff and #fefefe (UTexture.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@104 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index b50ab6bf..4a8fa786 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -361,7 +361,7 @@ begin for Pet := 0 to TexOrygH-1 do begin for Pet2 := 0 to TexOrygW-1 do begin Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - if Pix = Col then begin + if ((Pix = $fefefe) or (Pix = Col)) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; -- cgit v1.2.3 From 662b5574b22282511b3095c9888f0977b14eabdd Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Apr 2007 17:34:39 +0000 Subject: Commited UTheme.pas to prevent Conflicts git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@107 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 54 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 6837d17f..a5fb1459 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -542,6 +542,27 @@ type ButtonPrev: TThemeButton;} end; + //Stats Screens + TThemeStatMain = class(TThemeBasic) + ButtonScores: TThemeButton; + ButtonSingers: TThemeButton; + ButtonSongs: TThemeButton; + ButtonBands: TThemeButton; + + TextOverview: TThemeText; + end; + + TThemeStatDetail = class(TThemeBasic) + ButtonNext: TThemeButton; + ButtonPrev: TThemeButton; + ButtonReverse: TThemeButton; + ButtonExit: TThemeButton; + + Description: array[0..3] of string; + TextDescription: TThemeText; + TextList: AThemeText; + end; + //Playlist Translations TThemePlaylist = record CatText: string; @@ -580,6 +601,10 @@ type PartyOptions: TThemePartyOptions; PartyPlayer: TThemePartyPlayer; + //Stats Screens: + StatMain: TThemeStatMain; + StatDetail: TThemeStatDetail; + Playlist: TThemePlaylist; constructor Create(FileName: string); overload; // Initialize theme system @@ -665,6 +690,10 @@ begin PartyOptions := TThemePartyOptions.Create; PartyPlayer := TThemePartyPlayer.Create; + //Stats Screens: + StatMain := TThemeStatMain.Create; + StatDetail := TThemeStatDetail.Create; + LoadTheme(FileName, Color); @@ -1196,6 +1225,31 @@ begin {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'); + + 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'); + ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList'); + + 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'); + //Playlist Translations Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT') end; -- cgit v1.2.3 From 6d072496a4347995bc168ab978b878c375508ecd Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Apr 2007 17:39:51 +0000 Subject: Added Exit Button to Stats Screen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@108 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index a5fb1459..5a271ef6 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -547,7 +547,8 @@ type ButtonScores: TThemeButton; ButtonSingers: TThemeButton; ButtonSongs: TThemeButton; - ButtonBands: TThemeButton; + ButtonBands: TThemeButton; + ButtonExit: TThemeButton; TextOverview: TThemeText; end; @@ -1231,6 +1232,7 @@ begin ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers'); ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs'); ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands'); + ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit'); ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview'); -- cgit v1.2.3 From 7cbb58f6fe6cd8d81e21d6e0b1ebdc2fd872b773 Mon Sep 17 00:00:00 2001 From: mogguh Date: Tue, 17 Apr 2007 20:01:16 +0000 Subject: Feature: Added the possibility to skin the sing screen, it's now possible to set player 1 stuff related to player modi (1, 2 or 3 player mode) (affected UThemes.pas, UScreenSing.pas, UScreenSingModi.pas) Theme/Skin: Used the new sing screen possibility, looks way more ps3 now :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@109 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 118 +++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 70 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 5a271ef6..5aca1401 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -272,6 +272,18 @@ type TextP1: TThemeText; TextP1Score: TThemeText; + //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 @@ -896,52 +908,37 @@ begin ThemeLoadBasic(Sing, 'Sing'); ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); - - - //ScoreBG Mod - ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');//ScoreBG - //end ScoreBG Mod - - ThemeLoadText(Sing.TextP1, 'SingP1Text'); + ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); - + //Added for ps3 skin + //This one is shown in 2/4P mode + ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); + ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); + ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); + ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + + //This one is shown in 3/6P mode + ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); + ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); + ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); + ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + //eoa ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); - - - - //ScoreBG Mod - ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - //end ScoreBG Mod - - - ThemeLoadText(Sing.TextP2R, 'SingP2RText'); + ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); - - - //ScoreBG Mod - ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - //end ScoreBG Mod - - - ThemeLoadText(Sing.TextP2M, 'SingP2MText'); + ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); - - - //ScoreBG Mod - ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - //end ScoreBG Mod - - - ThemeLoadText(Sing.TextP3R, 'SingP3RText'); + ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); + //Line Bonus Texts Sing.LineBonusText[0] := Language.Translate('LINEBONUS_WORST'); Sing.LineBonusText[1] := Sing.LineBonusText[0]; @@ -1784,58 +1781,39 @@ begin ThemeSaveStatic(Song.StaticCat, 'SongStaticCat'); ThemeSaveBasic(Sing, 'Sing'); - ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); - - - - //ScoreBG Mod - ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); - //end ScoreBG Mod - - + ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); ThemeSaveText(Sing.TextP1, 'SingP1Text'); + ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); - ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); - - - - //ScoreBG Mod - ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - //end ScoreBG Mod - + //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'); - - - - //ScoreBG Mod - ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - //end ScoreBG Mod - - - - ThemeSaveText(Sing.TextP2M, 'SingP2MText'); + ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); - - - - //ScoreBG Mod - ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - //end ScoreBG Mod - - - - ThemeSaveText(Sing.TextP3R, 'SingP3RText'); + ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore'); ThemeSaveBasic(Score, 'Score'); -- cgit v1.2.3 From 6cdcfb402ce738dfc77b008fcb98fd1cda691eb5 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 19 Apr 2007 18:53:22 +0000 Subject: Added Statistic Screens to C0de and to Theme Moved some Translated Strings from UScreenPartyOptions to UTheme to use it with the Statistic Screens, too. Fixed use of /n Tag istead of the correct \n git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@118 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDataBase.pas | 131 ++++++++++++++++++++++++++++++++++++++++ Game/Code/Classes/UGraphic.pas | 36 +++++++---- Game/Code/Classes/UThemes.pas | 33 +++++++++- 3 files changed, 184 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index 1ebc18db..0e5a4a3f 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -8,6 +8,26 @@ uses USongs, SQLiteTable3; //DataBaseSystem - Class including all DB Methods //-------------------- type + TStatResult = record + Case Typ: Byte of + 0: (Singer: ShortString; + Score: Word; + Difficulty: Byte; + SongArtist: ShortString; + SongTitle: ShortString); + + 1: (Player: ShortString; + AverageScore: Word); + + 2: (Artist: ShortString; + Title: ShortString; + TimesSung: Word); + + 3: (ArtistName: ShortString; + TimesSungtot: Word); + end; + AStatResult = Array of TStatResult; + TDataBaseSystem = class private ScoreDB: TSqliteDatabase; @@ -15,12 +35,17 @@ type public + property Filename: String read sFilename; + Destructor Free; Procedure Init(const Filename: string); procedure ReadScore(var Song: TSong); procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); procedure WriteScore(var Song: TSong); + + Function GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; + Function GetTotalEntrys(const Typ: Byte): Cardinal; end; var @@ -160,4 +185,110 @@ begin end; end; +//-------------------- +//GetStats - Write some Stats to Array, Returns True if Chossen Page has Entrys +//Case Typ of +//0 - Best Scores +//1 - Best Singers +//2 - Most sung Songs +//3 - Most popular Band +//-------------------- +Function TDataBaseSystem.GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; +var + Query: String; + TableData: TSqliteTable; +begin + Result := False; + + if (Length(Stats) < Count) then + Exit; + + {Todo: + Add Prevention that only Players with more than 5 Scores are Selected at Typ 2} + + //Create Query + Case Typ of + 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `US_Scores` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; + 1: Query := 'SELECT `Player` , (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; + 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `US_Songs` ORDER BY `TimesPlayed`'; + 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `US_Songs` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; + end; + + //Add Order Direction + If Reversed then + Query := Query + ' ASC' + else + Query := Query + ' DESC'; + + //Add Limit + Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; + + //Execute Query + //try + TableData := ScoreDB.GetTable(Query); + {except + exit; + end;} + + //if Result empty -> Exit + if (TableData.RowCount < 1) then + exit; + + //Copy Result to Stats Array + while not TableData.Eof do + begin + Stats[TableData.Row].Typ := Typ; + + Case Typ of + 0:begin + Stats[TableData.Row].Singer := TableData.Fields[0]; + + Stats[TableData.Row].Difficulty := StrtoIntDef(TableData.Fields[1], 0); + + Stats[TableData.Row].Score := StrtoIntDef(TableData.Fields[2], 0){TableData.FieldAsInteger(2)}; + Stats[TableData.Row].SongArtist := TableData.Fields[3]; + Stats[TableData.Row].SongTitle := TableData.Fields[4]; + end; + + 1:begin + Stats[TableData.Row].Player := TableData.Fields[0]; + Stats[TableData.Row].AverageScore := TableData.FieldAsInteger(1); + end; + + 2:begin + Stats[TableData.Row].Artist := TableData.Fields[0]; + Stats[TableData.Row].Title := TableData.Fields[1]; + Stats[TableData.Row].TimesSung := StrtoIntDef(TableData.Fields[2], 0); + end; + + 3:begin + Stats[TableData.Row].ArtistName := TableData.Fields[0]; + Stats[TableData.Row].TimesSungtot := StrtoIntDef(TableData.Fields[1], 0); + end; + + end; + + TableData.Next; + end; + + Result := True; +end; + +//-------------------- +//GetTotalEntrys - Get Total Num of entrys for a Stats Query +//-------------------- +Function TDataBaseSystem.GetTotalEntrys(const Typ: Byte): Cardinal; +var Query: String; +begin + //Create Query + Case Typ of + 0: Query := 'SELECT COUNT(`SongID`) FROM `US_Scores`;'; + 1: Query := 'SELECT COUNT(DISTINCT `Player`) FROM `US_Scores`;'; + 2: Query := 'SELECT COUNT(`ID`) FROM `US_Songs`;'; + 3: Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `US_Songs`;'; + end; + + Result := ScoreDB.GetTableValue(Query); +end; + end. diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index b909e49f..342efe3c 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -7,7 +7,8 @@ uses UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, UScreenOptionsAdvanced, UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, - {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer; + {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer, + {Stats Screens} UScreenStatMain, UScreenStatDetail; type TRecR = record @@ -62,6 +63,10 @@ var ScreenPartyOptions: TScreenPartyOptions; ScreenPartyPlayer: TScreenPartyPlayer; + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + Tex_Left: array[0..6] of TTexture; Tex_Mid: array[0..6] of TTexture; @@ -221,20 +226,27 @@ var Icon: TIcon; Res: TResourceStream; ISurface: PSDL_Surface; + Pixel: PByteArray; begin Log.LogStatus('LoadOpenGL', 'Initialize3D'); Log.BenchmarkStart(2); LoadOpenGL; - {//Load Icon + Log.LogStatus('SDL_Init', 'Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin + Log.LogError('SDL_Init Failed', 'Initialize3D'); + exit; + end; + + { //Load Icon Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); Icon := TIcon.Create; Icon.LoadFromStream(Res); Res.Free; - + Icon. //Create icon Surface - SDL_CreateRGBSurface ( + SDL_CreateRGBSurfaceFrom ( SDL_SWSURFACE, Icon.Width, Icon.Height, @@ -243,18 +255,12 @@ begin 32 or 16, 8 or 4, 2 or 1); - SDL_BlitSurface( //} - + //SDL_BlitSurface( - SDL_WM_SetIcon(SDL_LoadBMP('us.ico'), 0); //} - Log.LogStatus('SDL_Init', 'Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin - Log.LogError('SDL_Init Failed', 'Initialize3D'); - exit; - end; + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} - SDL_WM_SetCaption(PChar(Title), 'WM_DEFAULT'); + SDL_WM_SetCaption(PChar(Title), nil); InitializeScreen; @@ -433,6 +439,10 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); ScreenPartyPlayer := TScreenPartyPlayer.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); end; end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 5aca1401..4f4ab2b9 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -570,10 +570,15 @@ type ButtonPrev: TThemeButton; ButtonReverse: TThemeButton; ButtonExit: TThemeButton; - - Description: array[0..3] of string; + 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 @@ -620,6 +625,8 @@ type 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 @@ -1242,15 +1249,35 @@ begin 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') + 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; -- cgit v1.2.3 From 34988301a511ca8552a954c231fafde007cb94a1 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 20 Apr 2007 15:29:48 +0000 Subject: Some Memory tweaking (13 MB Less Ram using at 800 Songs) Some Loading Time tweaking (From 8 Secs to 6 Secs on my Computer) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@123 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index cc3c8b95..4240d135 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -58,6 +58,9 @@ type end; TSongs = class + private + BrowsePos: Cardinal; //Actual Pos in Song Array + public Song: array of TSong; // array of songs Selected: integer; // selected song index procedure LoadSongList; // load all songs @@ -100,10 +103,14 @@ begin Log.LogStatus('Initializing', 'LoadSongList'); // clear - Setlength(Song, 0); + Setlength(Song, 50); + BrowsePos := 0; // browse directories BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos + 1); // if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); end; @@ -125,14 +132,19 @@ begin if FindFirst(Dir + '*.txt', 0, SR) = 0 then begin // Log.LogStatus('Parsing file: ' + Dir + SR.Name + '\' + SRD.Name, 'LoadSongList'); repeat + //New Mod for better Memory Management + + SLen := BrowsePos; + {//Old SLen := Length(Song); - SetLength(Song, SLen + 1); + SetLength(Song, SLen + 1);//} + Song[SLen].Path := Dir; Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos('\', Song[SLen].Folder)-1); Song[SLen].FileName := SR.Name; - if (AnalyseFile(Song[SLen]) = false) then SetLength(Song, SLen) + if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) else begin // scanning complete, file is good // if there is no cover then try to find it @@ -146,6 +158,14 @@ begin // Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; end; + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + until FindNext(SR) <> 0; end; // if FindFirst FindClose(SR); -- cgit v1.2.3 From 3c106109e17a62c0d6c3620fc290a90410cae84c Mon Sep 17 00:00:00 2001 From: mota23 Date: Fri, 20 Apr 2007 20:36:21 +0000 Subject: Made the Line-Popup pop up. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@125 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 193 +++++++++++++++++++------------------------- Game/Code/Classes/UMain.pas | 5 +- 2 files changed, 87 insertions(+), 111 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 410fbb2e..bd6b5db6 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -20,7 +20,7 @@ procedure SingGoldenStar(X, Y, A: real); procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); //Phrasen Bonus - Line Bonus -procedure SingDrawLineBonus( const X, Y: integer; Color: TRGB; Alpha: Single; Text: string); +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); //Draw Editor NoteLines procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); @@ -662,7 +662,6 @@ begin 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; @@ -685,14 +684,7 @@ begin glTexCoord2f(15/16, 1/16); glVertex2f(Rec.Right, Rec.Top); glEnd; glDisable(GL_BLEND); -{ glBegin(GL_QUADS); - glColor4f(26/255, 165/255, 220/255, 0); - glVertex2f(Rec.Left, Rec.Top); - glVertex2f(Rec.Left, Rec.Bottom); - glColor4f(26/255, 165/255, 220/255, BarAlpha); - glVertex2f(Rec.Right, Rec.Bottom); - glVertex2f(Rec.Right, Rec.Top); - glEnd;} + end; // oscilloscope @@ -793,58 +785,61 @@ begin for E := 0 to (PlayersPlay - 1) do begin //Change Alpha Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - if Player[E].LineBonus_Alpha <= 0 then - Player[E].LineBonus_Visible := False + begin + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False + end else begin + inc(Player[E].LineBonus_Age, 1); //Change Position if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Inc(Player[E].LineBonus_PosX,1) + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Dec(Player[E].LineBonus_PosX,1); + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Inc(Player[E].LineBonus_PosY,1) + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Dec(Player[E].LineBonus_PosY,1); + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); end; end; end; //if if PlayersPlay = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); end else if PlayersPlay = 2 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end else if PlayersPlay = 3 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end else if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end; if ScreenAct = 2 then begin - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); end; end; if PlayersPlay = 6 then begin if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end; if ScreenAct = 2 then begin - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text); - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); end; end; end; @@ -1056,24 +1051,28 @@ begin 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; - // 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);} - // gaszenie - if BarWspol > 0.95 then BarAlpha := 0.5 * (1 - (BarWspol - 0.95) * 20); - //Change fuer Crazy Joker - glEnable(GL_BLEND); - glBegin(GL_QUADS); - glColor4f(26/255, 165/255, 220/255, 0); - glVertex2f(Rec.Left, Rec.Top); - glVertex2f(Rec.Left, Rec.Bottom); - glColor4f(26/255, 165/255, 220/255, BarAlpha); - glVertex2f(Rec.Right, Rec.Bottom); - glVertex2f(Rec.Right, Rec.Top); - glEnd; - glDisable(GL_BLEND); + //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(1/16, 1/16); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(1/16, 15/16); glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(1, 1, 1, 0.5); + glTexCoord2f(15/16, 15/16); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(15/16, 1/16); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glDisable(GL_BLEND); end; // oscilloscope @@ -1207,20 +1206,27 @@ begin //Change Alpha Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + if Player[E].LineBonus_Alpha <= 0 then + begin + Player[E].LineBonus_Age := 0; Player[E].LineBonus_Visible := False + + end else begin + inc(Player[E].LineBonus_Age, 1); + //Change Position if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Inc(Player[E].LineBonus_PosX,1) + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Dec(Player[E].LineBonus_PosX,1); + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Inc(Player[E].LineBonus_PosY,1) + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Dec(Player[E].LineBonus_PosY,1); + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); end; end; @@ -1228,52 +1234,52 @@ begin if PlayersPlay = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); end else if PlayersPlay = 2 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end else if PlayersPlay = 3 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end else if PlayersPlay = 4 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); end; end; if PlayersPlay = 6 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); if PlayerInfo.Playerinfo[4].Enabled then - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text); + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); if PlayerInfo.Playerinfo[5].Enabled then - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text); + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); end; end; end; @@ -1492,16 +1498,17 @@ end; //end Singbar Mod //PhrasenBonus - Line Bonus Mod -procedure SingDrawLineBonus( const X, Y: integer; Color: TRGB; Alpha: Single; Text: string); +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 -SetFontSize(6); +if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6); SetFontItalic(False); //Check Font Size @@ -1510,56 +1517,24 @@ 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 glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - //Old Method with Variable Background - {//Draw Left Side - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusL.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y + Tex_SingLineBonusL.H * Tex_SingLineBonusL.ScaleH); - glTexCoord2f(1, 1); glVertex2f(X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW, Y + Tex_SingLineBonusL.H * Tex_SingLineBonusL.scaleH); - glTexCoord2f(1, 0); glVertex2f(X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW, Y); - glEnd; - //Set X of Next Tile - X2 := X + Tex_SingLineBonusL.W * Tex_SingLineBonusL.scaleW; - - //Draw Middle - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusM.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X2, Y); - glTexCoord2f(0, 1); glVertex2f(X2, Y + Tex_SingLineBonusM.H * Tex_SingLineBonusM.ScaleH); - glTexCoord2f(1, 1); glVertex2f(X2 + Length, Y + Tex_SingLineBonusM.H * Tex_SingLineBonusM.scaleH); - glTexCoord2f(1, 0); glVertex2f(X2 + Length, Y); - glEnd; - - //Set X of Next Tile - X2 := X2 + Length; - - //Draw Rigth Side - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusR.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X2, Y); - glTexCoord2f(0, 1); glVertex2f(X2, Y + Tex_SingLineBonusR.H * Tex_SingLineBonusR.ScaleH); - glTexCoord2f(1, 1); glVertex2f(X2 + Tex_SingLineBonusR.W * Tex_SingLineBonusR.scaleW, Y + Tex_SingLineBonusR.H * Tex_SingLineBonusR.scaleH); - glTexCoord2f(1, 0); glVertex2f(X2 + Tex_SingLineBonusR.W * Tex_SingLineBonusR.scaleW, Y); - glEnd;} //New Method, Not Variable glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack.TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/32, 0); glVertex2f(X, Y); - glTexCoord2f(1/32, 1); glVertex2f(X, Y + 50); - glTexCoord2f(31/32, 1); glVertex2f(X + 100, Y + 50); - glTexCoord2f(31/32, 0); glVertex2f(X + 100, Y); + glTexCoord2f(1/32, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); + glTexCoord2f(1/32, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); + glTexCoord2f(31/32, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); + glTexCoord2f(31/32, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); glEnd; glColor4f(1, 1, 1, Alpha); //Set Color diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 3b6be56e..c9002a36 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -26,12 +26,13 @@ type //end Singbar Mod //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: integer; - LineBonus_PosY: integer; + LineBonus_PosX: Single; + LineBonus_PosY: Single; LineBonus_Alpha: Single; LineBonus_Visible: boolean; LineBonus_Text: string; LineBonus_Color: TRGB; + LineBonus_Age: Integer; //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes LineBonus_TargetX: integer; -- cgit v1.2.3 From e7e9d945a53b293516c4a248abb042872759ba1d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 21 Apr 2007 17:42:22 +0000 Subject: Fixed some Bugs in Party Mode Fixed TeamScores are not Reseted Added SBGW to MenuSelectSlide3 to Fit the Menu a little bit More. Need much Work to be Perfect git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@126 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 43 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 40 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index e5252f82..946aca77 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -116,6 +116,7 @@ begin TeamMode := False; end; Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + Teams.Teaminfo[I].Score := 0; end; //Fill Plugin Array @@ -149,10 +150,46 @@ end; //---------- function TParty_Session.GetRandomPlayer(Team: Byte): Byte; var - I, J: Integer; + I, R: Integer; lowestTP: Byte; + NumPwithLTP: Byte; begin - //Get lowest TimesPlayed + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Players that have not often played yet + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Player + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + begin + //Player Found + if (R = 0) then + begin + Result := I; + Break; + end; + + Dec(R); + end; + end; + {//Get lowest TimesPlayed lowestTP := high(Byte); J := -1; for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do @@ -174,7 +211,7 @@ begin Result := Random(Teams.Teaminfo[Team].NumPlayers); until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) else //Else Select the one with lowest TP - Result:= J; + Result:= J;} end; //---------- -- cgit v1.2.3 From a32c1026810fb137ce6bcb72a7ee654fc8931504 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 23 Apr 2007 12:47:08 +0000 Subject: Fixed: SongSorting is CaseSensitive Inspired by official Ultrastar SVN git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@127 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 4240d135..0a319370 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -182,7 +182,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Edition < Song[S-1].Edition then begin + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -193,7 +193,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Genre < Song[S-1].Genre then begin + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -204,7 +204,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Title < Song[S-1].Title then begin + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -216,7 +216,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Artist < Song[S-1].Artist then begin + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -227,7 +227,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Folder < Song[S-1].Folder then begin + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -238,7 +238,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Title < Song[S-1].Title then begin + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -250,7 +250,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Artist < Song[S-1].Artist then begin + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin // zamiana miejscami TempSong := Song[S-1]; Song[S-1] := Song[S]; @@ -261,7 +261,7 @@ begin begin for S2 := 0 to Length(Song)-1 do for S := 1 to Length(Song)-1 do - if Song[S].Language < Song[S-1].Language then begin + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin TempSong := Song[S-1]; Song[S-1] := Song[S]; Song[S] := TempSong; @@ -330,7 +330,7 @@ case Ini.Sorting of for S := Low(Songs.Song) to High(Songs.Song) do begin if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (SS <> Songs.Song[S].Edition) then begin + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin // add Category Button Inc(Order); SS := Songs.Song[S].Edition; @@ -373,7 +373,7 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sGenre) and (SS <> Songs.Song[S].Genre) then begin + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin // add Genre Button Inc(Order); SS := Songs.Song[S].Genre; @@ -399,7 +399,7 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sLanguage) and (SS <> Songs.Song[S].Language) then begin + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin // add Language Button Inc(Order); SS := Songs.Song[S].Language; @@ -425,10 +425,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> Songs.Song[S].Title[1]) then begin + else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin // add a letter Category Button Inc(Order); - Letter := Songs.Song[S].Title[1]; + Letter := UpCase(Songs.Song[S].Title[1]); CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -453,10 +453,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> Songs.Song[S].Artist[1]) then begin + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin // add a letter Category Button Inc(Order); - Letter := Songs.Song[S].Artist[1]; + Letter := UpCase(Songs.Song[S].Artist[1]); CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -480,7 +480,7 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sFolder) and (SS <> Songs.Song[S].Folder) then begin + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin // 0.5.0: add folder tab Inc(Order); SS := Songs.Song[S].Folder; @@ -507,7 +507,7 @@ case Ini.Sorting of end else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := Songs.Song[S].Title[1]; + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); @@ -537,7 +537,7 @@ case Ini.Sorting of end else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := Songs.Song[S].Artist[1]; + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); -- cgit v1.2.3 From b49192ef9d03915744a65009e25f06fafd72bd30 Mon Sep 17 00:00:00 2001 From: mogguh Date: Mon, 23 Apr 2007 21:38:08 +0000 Subject: Feature: SingBar is now moveable via theme/skin (affects UDraw.pas, UThemes.pas, UScreenSing.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@128 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 100 ++++++++++++++++++++++++++++-------------- Game/Code/Classes/UThemes.pas | 27 ++++++++++++ 2 files changed, 94 insertions(+), 33 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index bd6b5db6..d18830ba 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -730,6 +730,7 @@ begin end //SingBar Mod + //modded again to make it moveable: it's working, so why try harder else if Ini.Oscilloscope = 2 then begin A := GetTickCount div 33; if A <> Tickold then begin @@ -741,37 +742,53 @@ begin end; //for end; //if if PlayersPlay = 1 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); end; if PlayersPlay = 2 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if PlayersPlay = 3 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if ScreenAct = 2 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); end; end; if PlayersPlay = 6 then begin if ScreenAct = 1 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); - end; + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; if ScreenAct = 2 then begin - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); end; end; end; @@ -1134,6 +1151,7 @@ begin end //SingBar Mod + // was fürn sinn hattn der quark hier? else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin A := GetTickCount div 33; if A <> Tickold then begin @@ -1146,52 +1164,68 @@ begin end; //if if PlayersPlay = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); end; if PlayersPlay = 2 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if PlayersPlay = 3 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; if PlayersPlay = 4 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); end; end; if PlayersPlay = 6 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); if PlayerInfo.Playerinfo[4].Enabled then - SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); + //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); if PlayerInfo.Playerinfo[5].Enabled then - SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); end; end; end; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 4f4ab2b9..33cf4258 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -272,6 +272,15 @@ type TextP1: TThemeText; 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; @@ -914,6 +923,15 @@ begin // Sing ThemeLoadBasic(Sing, 'Sing'); + //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'); @@ -1814,6 +1832,15 @@ begin 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'); -- cgit v1.2.3 From 6c530e99b8a5314bb1e988a00680ba4332ac4abc Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 24 Apr 2007 13:23:53 +0000 Subject: UTexture.pas: texture-wrap-mode changed to GL_CLAMP_TO_EDGE - solves some problems where edges of textures were drawn incorrectly UDisplay.pas: simplified generation of fade texture (a little) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@134 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 4a8fa786..0eae68a2 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -259,8 +259,8 @@ begin glGenTextures(1, ActTex); glBindTexture(GL_TEXTURE_2D, ActTex); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + 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 Typ = 'Plain' then begin // wymiary @@ -755,8 +755,8 @@ begin glGenTextures(1, ActTex); // ActText = new texture number glBindTexture(GL_TEXTURE_2D, ActTex); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); if Mipmapping then begin -- cgit v1.2.3 From d5cbbd6e1fa5934a79f9bdd63dca5778d5d177e0 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 24 Apr 2007 15:30:25 +0000 Subject: Fixed a Bug in PartyMode that causes that Players are not chossen fair git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@136 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 946aca77..b07ad5ad 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -55,7 +55,7 @@ var end; TeamMode: Boolean; Len: Integer; - I: Integer; + I, J: Integer; function GetRandomPlugin: Byte; var @@ -107,7 +107,7 @@ begin PlayersPlay := Teams.NumTeams; - //Get Teammode and Set Joker + //Get Teammode and Set Joker, also set TimesPlayed TeamMode := True; For I := 0 to Teams.NumTeams-1 do begin @@ -115,6 +115,11 @@ begin begin TeamMode := False; end; + //Set Player Attributes + For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do + begin + Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; + end; Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); Teams.Teaminfo[I].Score := 0; end; @@ -156,6 +161,7 @@ var 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 @@ -323,7 +329,7 @@ begin //Increase TimesPlayed 4 all Players For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[0].CurPlayer].TimesPlayed); + Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); end; -- cgit v1.2.3 From b595cf066cea127e3f890e880e67535d51ccbcf8 Mon Sep 17 00:00:00 2001 From: mota23 Date: Wed, 25 Apr 2007 18:42:25 +0000 Subject: Removed workarounds in UDraw.pas and Deluxe.ini. Altered Graphics to reflect the changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@138 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 136 ++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 68 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index d18830ba..f5722175 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -234,10 +234,10 @@ begin 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(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -251,10 +251,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(31/32, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -263,10 +263,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -336,10 +336,10 @@ var glColor3f(1, 1, 1); glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -356,10 +356,10 @@ var // glBindTexture(GL_TEXTURE_2D, Tex_MidGray.TexNum); glBindTexture(GL_TEXTURE_2D, Tex_Mid[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + 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; glColor3f(1, 1, 1); @@ -369,10 +369,10 @@ var glBindTexture(GL_TEXTURE_2D, Tex_Right[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + 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; @@ -474,10 +474,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + 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; @@ -487,10 +487,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(31/32, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -499,10 +499,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[NrGracza+1].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -677,11 +677,11 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); glBegin(GL_QUADS); glColor4f(1, 1, 1, 0); - glTexCoord2f(1/16, 1/16); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/16, 15/16); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); glColor4f(1, 1, 1, 0.5); - glTexCoord2f(15/16, 15/16); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(15/16, 1/16); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; glDisable(GL_BLEND); @@ -1083,11 +1083,11 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); glBegin(GL_QUADS); glColor4f(1, 1, 1, 0); - glTexCoord2f(1/16, 1/16); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/16, 15/16); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); glColor4f(1, 1, 1, 0.5); - glTexCoord2f(15/16, 15/16); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(15/16, 1/16); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; glDisable(GL_BLEND); end; @@ -1468,10 +1468,10 @@ begin; glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/16, 0); glVertex2f(X, Y); - glTexCoord2f(1/16, 1); glVertex2f(X, Y+H); - glTexCoord2f(1 - 1/16, 1); glVertex2f(X+W, Y+H); - glTexCoord2f(1 - 1/16, 0); glVertex2f(X+W, Y); + 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 @@ -1510,10 +1510,10 @@ begin; glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum); //Size= Player[PlayerNum].ScorePercent of W glBegin(GL_QUADS); - glTexCoord2f(1/16, 0); glVertex2f(X, Y); - glTexCoord2f(1/16, 1); glVertex2f(X, Y+H); - glTexCoord2f(1 - 1/16, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); - glTexCoord2f(1 - 1/16, 0); glVertex2f(X+(W/100 * (Percent +1)), Y); + 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 @@ -1565,10 +1565,10 @@ if Age < 5 then Size := Age * 10 else Size := 50; glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack.TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/32, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); - glTexCoord2f(1/32, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); - glTexCoord2f(31/32, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); - glTexCoord2f(31/32, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); + 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 @@ -1614,10 +1614,10 @@ begin 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(7/8, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(7/8, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -1626,10 +1626,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/32, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/32, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(31/32, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(31/32, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -1638,10 +1638,10 @@ begin glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); glBegin(GL_QUADS); - glTexCoord2f(1/8, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(1/8, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + 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 -- cgit v1.2.3 From e3ec6fbc344c9af26b80932d3a29fb4bf1f6c9a2 Mon Sep 17 00:00:00 2001 From: mogguh Date: Thu, 26 Apr 2007 00:11:39 +0000 Subject: Feature: Credits screen is now a screen for itself (UGraphic.pas, UScreenMain.pas, UScreenCredits.pas) Feature: Credits screen now has a tune in the background, thanks weezl <3 !! (place the mp3 into your "Sounds" path) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@141 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 342efe3c..df7cd411 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -8,7 +8,8 @@ uses UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer, - {Stats Screens} UScreenStatMain, UScreenStatDetail; + {Stats Screens} UScreenStatMain, UScreenStatDetail, + {CreditsScreen} UScreenCredits; type TRecR = record @@ -67,7 +68,10 @@ var ScreenStatMain: TScreenStatMain; ScreenStatDetail: TScreenStatDetail; + //CreditsScreen + ScreenCredits: TScreenCredits; + //Notes Tex_Left: array[0..6] of TTexture; Tex_Mid: array[0..6] of TTexture; Tex_Right: array[0..6] of TTexture; @@ -443,6 +447,9 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); ScreenStatDetail := TScreenStatDetail.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); -end; + ScreenCredits := TScreenCredits.Create(''); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + + end; end. -- cgit v1.2.3 From b2518890d0dd62eeb96ee8b4b5f2d86e61ca75e7 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 26 Apr 2007 19:42:55 +0000 Subject: Added PS3 like ButtonFade ability Some new ThemeButton Attributes: DeSelectReflectionSpacing: ReflectionSpacing when Button is not Selected Fade: Enable Stepings in Fading FadeText: Fade Texts with Button SelectW, SelectH: Width and Height when Button is Selected FadeTex: Texture used when Button Fades to not stretch the Texture. Not nessecary. FadeTexPos: Position of FadeTex git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@143 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 33cf4258..90bab7c1 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -134,6 +134,14 @@ type //Reflection Mod Reflection: boolean; Reflectionspacing: Real; + //Fade Mod + SelectH: integer; + SelectW: integer; + Fade: boolean; + FadeText: boolean; + DeSelectReflectionspacing : Real; + FadeTex: string; + FadeTexPos: integer; end; TThemeSelect = record @@ -1454,6 +1462,22 @@ begin ThemeButton.DColB := Color[C].RGB.B; end; + //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; + + //Read ButtonTexts TLen := ThemeIni.ReadInteger(Name, 'Texts', 0); SetLength(ThemeButton.Text, TLen); for T := 1 to TLen do -- cgit v1.2.3 From bda4fa8e57ca63a1d591433f120b4226d6a5d327 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 29 Apr 2007 17:50:29 +0000 Subject: Added 2 new Buttons to ScreenMain: Multi and Stats Updated Language Fiels to Fit with new Buttons Some CodeClean Up in Menu Class and in Screens Some minor Bug fixes I forgot about Added ability to group Buttons within a Screen New Theme Object: ButtonCollection: Same Attributes as a Button Plus FirstChild: Defining the First Button in the Group. For Example: SingSolo is 1, SingMulti Button is 2, in ScreenMain Added Attribute to Theme Button: Parent: Number of the assigned Group, 0 for no Group Used new Abilitys in MainScreen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@149 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 28 +++++----- Game/Code/Classes/UThemes.pas | 123 +++++++++++++++++++++++++++++++++-------- 2 files changed, 115 insertions(+), 36 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index df7cd411..39eea53d 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -375,7 +375,7 @@ end; procedure LoadScreens; begin - ScreenLoading := TScreenLoading.Create(''); + ScreenLoading := TScreenLoading.Create; ScreenLoading.onShow; Display.ActualScreen := @ScreenLoading; ScreenLoading.Draw; @@ -397,35 +397,35 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); ScreenSing := TScreenSing.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create(''); + ScreenScore := TScreenScore.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); ScreenTop5 := TScreenTop5.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create(''); + ScreenOptions := TScreenOptions.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create(''); + ScreenOptionsGame := TScreenOptionsGame.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create(''); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create(''); + ScreenOptionsSound := TScreenOptionsSound.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create(''); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create(''); + ScreenOptionsThemes := TScreenOptionsThemes.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); ScreenOptionsRecord := TScreenOptionsRecord.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create(''); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create(''); + ScreenEditSub := TScreenEditSub.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create(''); + ScreenEdit := TScreenEdit.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create(''); + ScreenEditConvert := TScreenEditConvert.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); // ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); // Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create(''); + ScreenOpen := TScreenOpen.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); ScreenSingModi := TScreenSingModi.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); @@ -447,7 +447,7 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); ScreenStatDetail := TScreenStatDetail.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create(''); + ScreenCredits := TScreenCredits.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); end; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 90bab7c1..31081f23 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -142,8 +142,21 @@ type 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; @@ -186,10 +199,14 @@ type SkipX: integer; end; + PThemeBasic = ^TThemeBasic; TThemeBasic = class Background: TThemeBackground; Text: AThemeText; Static: AThemeStatic; + + //Button Collection Mod + ButtonCollection: AThemeButtonCollection; end; TThemeLoading = class(TThemeBasic) @@ -199,15 +216,16 @@ type TThemeMain = class(TThemeBasic) ButtonSolo: TThemeButton; -// ButtonMulti: TThemeButton; + ButtonMulti: TThemeButton; + ButtonStat: TThemeButton; ButtonEditor: TThemeButton; ButtonOptions: TThemeButton; ButtonExit: TThemeButton; TextDescription: TThemeText; TextDescriptionLong: TThemeText; - Description: array[0..4] of string; - DescriptionLong: array[0..4] of string; + Description: array[0..5] of string; + DescriptionLong: array[0..5] of string; end; TThemeName = class(TThemeBasic) @@ -604,12 +622,16 @@ type end; TTheme = class + private {$IFDEF THEMESAVE} ThemeIni: TIniFile; {$ELSE} ThemeIni: TMemIniFile; {$ENDIF} + LastThemeBasic: TThemeBasic; + public + Loading: TThemeLoading; Main: TThemeMain; Name: TThemeName; @@ -656,7 +678,9 @@ type 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); + 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); @@ -692,7 +716,7 @@ uses {{$IFDEF TRANSLATE} ULanguage, {{$ENDIF} -USkins, UIni; +USkins, UIni, Dialogs; constructor TTheme.Create(FileName: string); begin @@ -830,24 +854,30 @@ begin 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'); - //Score Text Translation Start + //Main Desc Text Translation Start {{$IFDEF TRANSLATE} Main.Description[0] := Language.Translate('SING_SING'); Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); - Main.Description[1] := Language.Translate('SING_EDITOR'); - Main.DescriptionLong[1] := Language.Translate('SING_EDITOR_DESC'); - Main.Description[2] := Language.Translate('SING_GAME_OPTIONS'); - Main.DescriptionLong[2] := Language.Translate('SING_GAME_OPTIONS_DESC'); - Main.Description[3] := Language.Translate('SING_EXIT'); - Main.DescriptionLong[3] := Language.Translate('SING_EXIT_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'); {{$ENDIF} - //Score Text Translation End + //Main Desc Text Translation End Main.TextDescription.Text := Main.Description[0]; Main.TextDescriptionLong.Text := Main.DescriptionLong[0]; @@ -931,14 +961,14 @@ begin // Sing ThemeLoadBasic(Sing, 'Sing'); - //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 + //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'); @@ -1315,6 +1345,9 @@ 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); @@ -1417,11 +1450,40 @@ begin end; end; -procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string); +//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 DecimalSeparator := '.'; ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); @@ -1477,6 +1539,23 @@ begin 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); -- cgit v1.2.3 From cc06446d0a651113083478fda94dfaa9a25d1d7e Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 29 Apr 2007 18:29:42 +0000 Subject: Commented some Debuging Outputs in ULog Fixed a Bug in ButtonCollection that causes a Crash when UpButton is Pressed at the Last Button Added ShortCut E in MainMenu for Editor git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@150 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 6bffa04e..0b492cb3 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -139,7 +139,7 @@ var Miliseconds: integer; ValueText: string; begin - if Ini.Debug = 1 then begin + //if Ini.Debug = 1 then begin if not FileAnalyzeO then begin AssignFile(FileAnalyze, LogPath + 'Analyze.log'); @@ -154,7 +154,7 @@ begin Flush(FileAnalyze); // try to speed up end; - end; + //end; end; procedure TLog.LogError(Text: string); @@ -202,8 +202,9 @@ end; procedure TLog.LogStatus(Log1, Log2: string); begin -//asd - LogError (Log2 + ': ' + Log1); + //Just for Debugging + //Comment for Release + //LogAnalyze (Log2 + ': ' + Log1); end; procedure TLog.LogError(Log1, Log2: string); @@ -224,4 +225,3 @@ begin end; end. - \ No newline at end of file -- cgit v1.2.3 From 37f734e1943563ca121791eabb9bff067a591e3d Mon Sep 17 00:00:00 2001 From: mota23 Date: Mon, 30 Apr 2007 09:24:50 +0000 Subject: Added new Static to ScreenPartyNewRound. Some Themework in Party-Mode. Still needs work. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@151 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 31081f23..414da72f 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -520,6 +520,9 @@ type StaticTeam1: TThemeStatic; StaticTeam2: TThemeStatic; StaticTeam3: TThemeStatic; + StaticNextPlayer1: TThemeStatic; + StaticNextPlayer2: TThemeStatic; + StaticNextPlayer3: TThemeStatic; ButtonNext: TThemeButton; end; @@ -1214,6 +1217,9 @@ begin ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); ThemeLoadButton (PartyNewRound.ButtonNext, 'PartyNewRoundButtonNext'); -- cgit v1.2.3 From 5737662e749229ef0631e3731858a5bf013c78eb Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 30 Apr 2007 12:30:35 +0000 Subject: Added ability to make buttons invisible(and also unselectable) in Theme. Visible = 0 Useful for f.e. the Exit Button from MainScreen Fixed a bug in PartyNewRoundScreen that causes a crash when an Arrow Button is pressed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@152 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 414da72f..47c1abf1 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -131,6 +131,9 @@ type DInt: real; Tex: string; Typ: string; + + Visible: Boolean; + //Reflection Mod Reflection: boolean; Reflectionspacing: Real; @@ -1530,6 +1533,8 @@ begin 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); -- cgit v1.2.3 From ac508bab2e69d6ed7987c23f383ed503a310785c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 30 Apr 2007 15:50:23 +0000 Subject: Added new Object to PartyNewRound Screen TextTeam[1..3]Players: Text shows the Players of the Team git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@153 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 47c1abf1..6004502e 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -520,14 +520,16 @@ type TextNameTeam1: TThemeText; TextNameTeam2: TThemeText; TextNameTeam3: TThemeText; + TextTeam1Players: TThemeText; + TextTeam2Players: TThemeText; + TextTeam3Players: TThemeText; + StaticTeam1: TThemeStatic; StaticTeam2: TThemeStatic; StaticTeam3: TThemeStatic; StaticNextPlayer1: TThemeStatic; StaticNextPlayer2: TThemeStatic; StaticNextPlayer3: TThemeStatic; - - ButtonNext: TThemeButton; end; TThemePartyScore = class(TThemeBasic) @@ -1217,6 +1219,10 @@ begin 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'); @@ -1224,8 +1230,6 @@ begin ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); - ThemeLoadButton (PartyNewRound.ButtonNext, 'PartyNewRoundButtonNext'); - //Party Score ThemeLoadBasic(PartyScore, 'PartyScore'); -- cgit v1.2.3 From dfa0f5a144b8bf018b29d801f7d8a7c54ae6d108 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 2 May 2007 17:44:23 +0000 Subject: 2 Bugs Fixed: Select Last Song instead First Song when showing Song Screen for the first Time Go to MainScreen instead of Song Screen when pressing Esc in the Name Screen after Selecting Select Players from Menu git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@154 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index a6207c4f..15e17047 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -217,6 +217,7 @@ begin end; finally + log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); CloseFile(F); end; end; -- cgit v1.2.3 From 5bf0ebf274fef28811ab952338bd261bd1dd0fa8 Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 3 May 2007 00:19:52 +0000 Subject: added "popups" to ask for confirmation when leaving party mode or game or to display messages (like minor errors) still ugly, needs some theme work git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@157 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 11 ++++++++++- Game/Code/Classes/UMain.pas | 9 +++++++-- Game/Code/Classes/UThemes.pas | 28 ++++++++++++++++++++++++++++ 3 files changed, 45 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 39eea53d..8b17a73d 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -9,7 +9,8 @@ uses UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer, {Stats Screens} UScreenStatMain, UScreenStatDetail, - {CreditsScreen} UScreenCredits; + {CreditsScreen} UScreenCredits, + {Popup for errors, etc.} UScreenPopup; type TRecR = record @@ -71,6 +72,10 @@ var //CreditsScreen ScreenCredits: TScreenCredits; + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + //Notes Tex_Left: array[0..6] of TTexture; Tex_Mid: array[0..6] of TTexture; @@ -433,6 +438,10 @@ begin Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); ScreenSongJumpto := TScreenSongJumpto.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); ScreenPartyNewRound := TScreenPartyNewRound.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); ScreenPartyScore := TScreenPartyScore.Create; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index c9002a36..69eca419 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -2,7 +2,7 @@ unit UMain; interface uses SDL, UGraphic, UMusic, URecord, UTime, SysUtils, UDisplay, UIni, ULog, ULyrics, UScreenSing, - OpenGL12, zlportio {you can disable it and all PortWriteB calls}, ULCD, ULight, UThemes; + OpenGL12, zlportio {you can disable it and all PortWriteB calls}, ULCD, ULight, UThemes{, UScreenPopup}; type TPlayer = record @@ -112,7 +112,7 @@ begin CheckEvents; // display - Display.Draw; + done:=not Display.Draw; SwapBuffers; // light @@ -156,6 +156,11 @@ Begin End; // With} SDL_KEYDOWN: begin + // popup hack... if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + if ScreenPopupError <> NIL then if ScreenPopupError.Visible then ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) else + if ScreenPopupCheck <> NIL then if ScreenPopupCheck.Visible then ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) else + // end of popup hack if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)) then // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then done := true; // exit game diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 6004502e..ee88ca9c 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -460,6 +460,19 @@ type 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; @@ -656,6 +669,9 @@ type OptionsThemes: TThemeOptionsThemes; OptionsRecord: TThemeOptionsRecord; OptionsAdvanced: TThemeOptionsAdvanced; + //error and check popup + ErrorPopup: TThemeError; + CheckPopup: TThemeCheck; //ScreenSong extensions SongMenu: TThemeSongMenu; SongJumpto: TThemeSongJumpTo; @@ -750,6 +766,9 @@ begin OptionsRecord := TThemeOptionsRecord.Create; OptionsAdvanced := TThemeOptionsAdvanced.Create; + ErrorPopup := TThemeError.Create; + CheckPopup := TThemeCheck.Create; + SongMenu := TThemeSongMenu.Create; SongJumpto := TThemeSongJumpto.Create; //Party Screens @@ -1157,6 +1176,15 @@ begin ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); 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'); -- cgit v1.2.3 From 0f327cf133373168d94538686b57c22ba364f2a8 Mon Sep 17 00:00:00 2001 From: mogguh Date: Thu, 3 May 2007 21:09:24 +0000 Subject: Feature: It's now possible to move/skin the time progress thing (no fix positions anymore) (affected: UDraw.pas, UGraphic.pas, UThemes.pas, UScreenSing.pas, UScreenSingModi.pas) Theme/Skin: Added the time stuff beneath the lyrics (as "the others" did too) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@164 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 65 +++++++++++++++++++++++++----------------- Game/Code/Classes/UGraphic.pas | 6 +++- Game/Code/Classes/UThemes.pas | 18 +++++++++++- 3 files changed, 61 insertions(+), 28 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index f5722175..41225c0d 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -12,6 +12,11 @@ procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); + +// TimeBar mod +procedure SingDrawTimeBar(); +// eoa TimeBar mod + { for no use since we have UGraphicClasses procedure SingDrawStar(X, Y, A: real); procedure SingGoldenStar(X, Y, A: real); @@ -615,20 +620,9 @@ begin // background //BG Fullsize Mod //SingDrawBackground; - // time bar -// Log.LogStatus('Time Bar', 'SingDraw'); - glBegin(GL_QUADS); - glColor3f(0.9, 0.9, 0.9); - glVertex2f(140 + 10*ScreenX, 21); - glVertex2f(140 + 10*ScreenX, 29); - glVertex2f(330 + 10*ScreenX, 29); - glVertex2f(330 + 10*ScreenX, 21); - glColor3f(Skin_TimeR, Skin_TimeG, Skin_TimeB); - glVertex2f(140 + 10*ScreenX, 21); - glVertex2f(140 + 10*ScreenX, 29); - glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 29); - glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 21); - glEnd; + //TimeBar mod + SingDrawTimeBar(); + //eoa TimeBar mod // rysuje paski pod nutami if PlayersPlay = 1 then @@ -1020,18 +1014,7 @@ begin // time bar // Log.LogStatus('Time Bar', 'SingDraw'); - glBegin(GL_QUADS); - glColor3f(0.9, 0.9, 0.9); - glVertex2f(140 + 10*ScreenX, 21); - glVertex2f(140 + 10*ScreenX, 29); - glVertex2f(330 + 10*ScreenX, 29); - glVertex2f(330 + 10*ScreenX, 21); - glColor3f(Skin_TimeR, Skin_TimeG, Skin_TimeB); - glVertex2f(140 + 10*ScreenX, 21); - glVertex2f(140 + 10*ScreenX, 29); - glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 29); - glVertex2f(140 + 10*ScreenX+(330-140)*(Czas.Teraz/Czas.Razem), 21); - glEnd; + SingDrawTimeBar(); if DLLMan.Selected.ShowNotes then begin @@ -1652,5 +1635,35 @@ begin glDisable(GL_TEXTURE_2D); end; +procedure SingDrawTimeBar(); +var x,y: real; + width, height: real; +begin + x := Theme.Sing.StaticTimeProgress.x; + y := Theme.Sing.StaticTimeProgress.y; + width:= Theme.Sing.StaticTimeProgress.w; + height:= Theme.Sing.StaticTimeProgress.h; + + glColor4f(Theme.Sing.StaticTimeProgress.ColR, + Theme.Sing.StaticTimeProgress.ColG, + Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + + glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(x,y); + glTexCoord2f(0, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); + glTexCoord2f(1, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); + glTexCoord2f(1, 0); glVertex2f(x, y+height); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1,1,1,1); +end; + end. diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 8b17a73d..7fd159f7 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -93,7 +93,7 @@ var Tex_Lyric_Help_Bar: TTexture; FullScreen: boolean; - + Tex_TimeProgress: TTexture; //Sing Bar Mod Tex_SingBar_Back: TTexture; @@ -211,6 +211,10 @@ begin Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + //SingBar Mod Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index ee88ca9c..7f4763c3 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -296,9 +296,15 @@ type end; TThemeSing = class(TThemeBasic) + + //TimeBar mod + StaticTimeProgress: TThemeStatic; + TextTimeText : TThemeText; + //eoa TimeBar mod + StaticP1: TThemeStatic; - StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG TextP1: TThemeText; + StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG TextP1Score: TThemeText; //moveable singbar mod @@ -988,6 +994,11 @@ begin // 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'); @@ -1973,6 +1984,11 @@ begin 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'); -- cgit v1.2.3 From 042a5e57be1ada25cbbc6e7f5f34c0c0ea5e9de2 Mon Sep 17 00:00:00 2001 From: mota23 Date: Mon, 7 May 2007 19:17:25 +0000 Subject: Some Themework done. Added new Statics to ScreenPartyScore. [PartyScoreStaticTeam(n)BG and Deco] To do: 1 Screen in Party-Mode, SingScreen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@177 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 7f4763c3..ea2328f9 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -559,8 +559,14 @@ type 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; @@ -1280,8 +1286,14 @@ begin 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'); ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); -- cgit v1.2.3 From b61e647b67ac0d449d764b89b117a3ac8b603403 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 8 May 2007 19:00:47 +0000 Subject: Readded Q Shortcut (Exit Application) on all Screens Clean up Popup Code a little bit git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@180 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 69eca419..29ca5fcb 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -112,7 +112,7 @@ begin CheckEvents; // display - done:=not Display.Draw; + done := not Display.Draw; SwapBuffers; // light @@ -158,12 +158,35 @@ Begin begin // popup hack... if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - if ScreenPopupError <> NIL then if ScreenPopupError.Visible then ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) else - if ScreenPopupCheck <> NIL then if ScreenPopupCheck.Visible then ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) else + if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + // end of popup hack - if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)) then -// if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then - done := true; // exit game + + else + begin + // check for Screen want to Exit + done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + + //If Screen wants to Exit + if done then + begin + //If Question Option is enabled then Show Exit Popup + if (Ini.AskbeforeDel = 1) then + begin + Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); + end + else //When asking for exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then end; // SDL_JOYAXISMOTION: // begin -- cgit v1.2.3 From e452e8c6d60af8e8a8eb957f1ef59d461f48c99a Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 8 May 2007 19:55:34 +0000 Subject: Fixed the "one Song too much" Bug Added 2 Error Messages: When Opening Sing or Party: No Songs Loaded When Opening Party: No Plugins loaded Added Messages to Language File git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@182 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 0a319370..4b49127c 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -110,7 +110,7 @@ begin BrowseDir(SongPath); //Set Correct SongArray Length - SetLength(Song, BrowsePos + 1); + SetLength(Song, BrowsePos); // if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); end; -- cgit v1.2.3 From e0b0396acf6101acf2608d9fe4b36fa735196b2a Mon Sep 17 00:00:00 2001 From: mota23 Date: Wed, 9 May 2007 03:26:41 +0000 Subject: Some Themework done. Added new Statics to PartyWin. [PartyWinStaticTeam(n)BG and Deco] Fix: bug in PartyScore (esc skipped to PartyNewRound where PartyWin should come) Disabled Esc in PartyWin. To do: Sing-Screen, Stats git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@183 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index ea2328f9..e8f8eb10 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -579,8 +579,14 @@ type 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; @@ -1308,8 +1314,14 @@ begin 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'); -- cgit v1.2.3 From 48e9a9faea54c6fa5b2b98e242444ae4c0183a7a Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 9 May 2007 16:45:46 +0000 Subject: Fix: Readded ability to close the Window Fix: Crash when SongScreen is opened in PartyMode when Tabs = On. Caused by SelectRandomSong procedure Upd: M in SongScreen works now in PartyMode, too git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@184 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 29ca5fcb..47860198 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -145,7 +145,11 @@ Begin Begin // beep; Case Event.type_ Of - SDL_QUITEV: done := true; + SDL_QUITEV: begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; { SDL_MOUSEBUTTONDOWN: With Event.button Do Begin -- cgit v1.2.3 From dcb6e5d386735b3ced44d7c6d6280343a16ca7db Mon Sep 17 00:00:00 2001 From: mota23 Date: Thu, 10 May 2007 00:57:17 +0000 Subject: Some Themework in Stats and SingScreen. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@187 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 7fd159f7..205fa9fd 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -146,7 +146,7 @@ const Skin_OscG = 0; Skin_OscB = 0; - Skin_LyricsT = 500; // 510 / 400 + Skin_LyricsT = 494; // 500 / 510 / 400 Skin_SpectrumT = 470; Skin_SpectrumBot = 570; Skin_SpectrumH = 100; -- cgit v1.2.3 From 4036ca0937c05444b23018a19d69d1aef90495db Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 12 May 2007 09:17:15 +0000 Subject: Party Win Screen now works the way it should. The Statics are sorted by Score git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@190 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index b07ad5ad..7bf3dd1b 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -10,6 +10,13 @@ type Winner: Byte; end; + TeamOrderEntry = record + Teamnum: Byte; + Score: Byte; + end; + + TeamOrderArray = Array[0..5] of Byte; + TParty_Session = class private function GetRandomPlayer(Team: Byte): Byte; @@ -25,7 +32,7 @@ type procedure StartNewParty(NumRounds: Byte); procedure StartRound; procedure EndRound; - function GetWinner: Byte; + function GetTeamOrder: TeamOrderArray; function GetWinnerString(Round: Byte): String; end; @@ -334,11 +341,34 @@ begin end; //---------- -//Get Winner - Gives back the Number of the total Winner +//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] //---------- -function TParty_Session.GetWinner: Byte; +function TParty_Session.GetTeamOrder: TeamOrderArray; +var + I, J: Integer; + ATeams: array [0..5] of TeamOrderEntry; + TempTeam: TeamOrderEntry; begin + //Fill Team Array + For I := 0 to Teams.NumTeams-1 do + begin + ATeams[I].Teamnum := I; + ATeams[I].Score := Teams.Teaminfo[I].Score; + end; + //Sort Teams + for J := 0 to Teams.NumTeams-1 do + for I := 1 to Teams.NumTeams-1 do + if ATeams[I].Score > ATeams[I-1].Score then + begin + TempTeam := ATeams[I-1]; + ATeams[I-1] := ATeams[I]; + ATeams[I] := TempTeam; + end; + + //Copy to Result + For I := 0 to Teams.NumTeams-1 do + Result[I] := ATeams[I].TeamNum; end; end. -- cgit v1.2.3 From 3d11b9a0a30438bb61df88a91dc7318cdf45a4a8 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 12 May 2007 09:20:21 +0000 Subject: Changed Standard Position for Covers and Equalizer, so that, if no Cover Positions are specified in Team, it looks like the Covers in X-Mas Mod git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@191 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index e8f8eb10..b92ef4fb 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -953,9 +953,8 @@ begin ThemeLoadText(Song.TextCat, 'SongTextCat'); //Load Cover Pos and Size from Theme Mod - Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 400); + Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 140); - Song.Cover.Z := ThemeIni.ReadInteger('SongCover', 'Z', 250); Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4); @@ -967,8 +966,8 @@ begin 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', 650); - Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 430); + 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); -- cgit v1.2.3 From 66f4c5511f1cc61b68e75d874ea6a1dc88f9e75a Mon Sep 17 00:00:00 2001 From: mota23 Date: Tue, 15 May 2007 18:04:42 +0000 Subject: Added: Keys 1.2.3 to use Joker in Popup-Party-Menu Added: 2 sets of Statics for Song-Screen. (need work, just startet) Some Fixes in Deluxe Theme. (missing texts, fixed positions etc.) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@194 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index b92ef4fb..d3358440 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -293,6 +293,13 @@ type StaticTeam3Joker3: TThemeStatic; StaticTeam3Joker4: TThemeStatic; StaticTeam3Joker5: TThemeStatic; + + + + StaticKeys1 : TThemeStatic; + TextKeys1 : TThemeText; + + end; TThemeSing = class(TThemeBasic) @@ -1002,6 +1009,9 @@ begin ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); + ThemeLoadStatic(Song.StaticKeys1, 'SongStaticKeys1'); + ThemeLoadText(Song.TextKeys1, 'SongStaticKeys1Text'); + // Sing ThemeLoadBasic(Sing, 'Sing'); -- cgit v1.2.3 From 9b29c5321e423fbe6ba29f32bdcf8f2c83828e92 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 16 May 2007 18:18:37 +0000 Subject: Fixed text position of SelectSlide when High is not 70 Added ability to change Z and Textsize from SelectSlide Use new abilitys to finish SongMenu Screen in Deluxe Theme git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@196 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index d3358440..b9183740 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -186,6 +186,9 @@ type Y: integer; W: integer; H: integer; + Z: real; + + TextSize: integer; //SBGW Mod SBGW: integer; @@ -1717,6 +1720,11 @@ begin 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); -- cgit v1.2.3 From 4a731514163a14bd3a9222d99707880b56772663 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 16 May 2007 19:19:35 +0000 Subject: all SongFile Loading and Saving procedures moved to UFiles. Added Some Tolerance in Song File Loading and Song Header Loading. Fix: Programm doesn't Crash anymore when a coruppted Song is loaded for Singing or Editing. Now Jump back to SongScreen and show an Error Message. Also Party Mode is not Interupted, a new Song will be selected automatically. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@197 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCatCovers.pas | 2 +- Game/Code/Classes/UCovers.pas | 2 +- Game/Code/Classes/UDLLManager.pas | 2 +- Game/Code/Classes/UFiles.pas | 494 ++++++++++++++++++++++++++++++++++++-- Game/Code/Classes/UIni.pas | 2 +- Game/Code/Classes/ULanguage.pas | 2 +- Game/Code/Classes/ULog.pas | 2 +- Game/Code/Classes/UMusic.pas | 2 +- Game/Code/Classes/UPlaylist.pas | 2 +- Game/Code/Classes/USongs.pas | 2 +- 10 files changed, 479 insertions(+), 33 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas index 00a758c8..34742902 100644 --- a/Game/Code/Classes/UCatCovers.pas +++ b/Game/Code/Classes/UCatCovers.pas @@ -24,7 +24,7 @@ var CatCovers: TCatCovers; implementation -uses IniFiles, SysUtils, Classes, UPliki, ULog; +uses IniFiles, SysUtils, Classes, UFiles, ULog; constructor TCatCovers.Create; begin diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 55329fd2..5b0a06d4 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -34,7 +34,7 @@ var Covers: TCovers; implementation -uses UPliki, ULog, DateUtils; +uses UFiles, ULog, DateUtils; constructor TCovers.Create; begin diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 151f0617..59c75d5b 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -1,7 +1,7 @@ unit UDLLManager; interface -uses ModiSDK, UPliki; +uses ModiSDK, UFiles; type TDLLMan = class diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index fed9b7f1..912a476d 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -4,43 +4,54 @@ interface uses USongs, SysUtils, ULog, UMusic; -//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs +procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header procedure ClearSong(var Song: TSong); //Clears Song Header values -//procedure CzyscNuty; -//function WczytajCzesci(Name: string): boolean; -//function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; -//function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +//Methodes Loading and Saving Songfiles +procedure ResetSingTemp; +procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); +function LoadSong(Name: string): boolean; +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; + + var - {//Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; ScreenshotsPath: string; CoversPath: string; - LanguagesPath: string; //} + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; SongFile: TextFile; // all procedures in this unit operates on this file FileLineNo: integer; //Line which is readed at Last, for error reporting - {// variables available for all procedures + // variables available for all procedures Base: array[0..1] of integer; - Rel: array[0..1] of integer;//} + Rel: array[0..1] of integer; Mult: integer = 1; MultBPM: integer = 4; implementation -uses TextGL, UIni, UMain, UPliki; +uses TextGL, UIni, UMain; - //Function sets All Absolute Paths eg. for Songs -{procedure InitializePaths; +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; +var + Writeable: Boolean; begin GamePath := ExtractFilePath(ParamStr(0)); + SoundPath := GamePath + 'Sounds\'; SongPath := GamePath + 'Songs\'; LogPath := GamePath; @@ -48,11 +59,43 @@ begin ScreenshotsPath := GamePath + 'Screenshots\'; CoversPath := GamePath + 'Covers\'; LanguagesPath := GamePath + 'Languages\'; + PluginPath := GamePath + 'Plugins\'; + PlaylistPath := GamePath + 'Playlists\'; + + //After Setting Paths, make sure that Paths exist + If not DirectoryExists(SoundPath) then + Writeable := ForceDirectories(SoundPath); + + If Writeable And (not DirectoryExists(SongPath)) then + Writeable := ForceDirectories(SongPath); + + If Writeable And (not DirectoryExists(ThemePath)) then + Writeable := ForceDirectories(ThemePath); + + If Writeable And (not DirectoryExists(ScreenshotsPath)) then + Writeable := ForceDirectories(ScreenshotsPath); + + If Writeable And (not DirectoryExists(CoversPath)) then + Writeable := ForceDirectories(CoversPath); + + If Writeable And (not DirectoryExists(LanguagesPath)) then + Writeable := ForceDirectories(LanguagesPath); + + If Writeable And (not DirectoryExists(PluginPath)) then + Writeable := ForceDirectories(PluginPath); + + If Writeable And (not DirectoryExists(PlaylistPath)) then + Writeable := ForceDirectories(PlaylistPath); + + if not Writeable then + Log.LogError('Error: Dir is Readonly'); DecimalSeparator := ','; -end;} +end; - //Clears Song Header values +//-------------------- +// Clears Song Header values +//-------------------- procedure ClearSong(var Song: TSong); begin //Main Information @@ -80,7 +123,9 @@ begin Song.Creator := ''; end; - //Reads Standard TXT Header +//-------------------- +// Reads Standard TXT Header +//-------------------- function ReadTXTHeader(var Song: TSong): boolean; var Line, Identifier, Value: String; @@ -100,7 +145,7 @@ begin end; //Read Lines while Line starts with # - While (Line[1] = '#') do + While (Length(Line) = 0) OR (Line[1] = '#') do begin //Increase Line Number Inc (FileLineNo); @@ -279,9 +324,9 @@ begin break; end; - //End on first empty Line + {//End on first empty Line if (Length(Line) = 0) then - break; + break;} end; //Check if all Required Values are given @@ -302,7 +347,9 @@ begin end; - //Analyse Song File and Read Header +//-------------------- +// Analyse Song File and Read Header +//-------------------- function AnalyseFile(var Song: TSong): boolean; begin Result := False; @@ -331,6 +378,405 @@ Result := False; end;} end; +//-------------------- +// Resets the temporary Sentence Arrays for each Player and some other Variables +//-------------------- +procedure ResetSingTemp; +var + Pet: integer; +begin + SetLength(Czesci, Length(Player)); + SetLength(AktSong.BPM, 0); + for Pet := 0 to High(Player) do begin + SetLength(Czesci[Pet].Czesc, 1); + SetLength(Czesci[Pet].Czesc[0].Nuta, 0); + Czesci[Pet].Czesc[0].Lyric := ''; + Czesci[Pet].Czesc[0].LyricWidth := 0; + Player[pet].Score := 0; + Player[pet].IlNut := 0; + Player[pet].HighNut := -1; + end; + //Reset Path and Filename Values to Prevent Errors in Editor + AktSong.Path := ''; + AktSong.FileName := ''; +end; + +//-------------------- +// Parses Note Infos and save them to Array +//-------------------- +procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +var + Space: boolean; +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin + SetLength(Nuta, Length(Nuta) + 1); + IlNut := IlNut + 1; + HighNut := HighNut + 1; + Muzyka.IlNut := Muzyka.IlNut + 1; + + Nuta[HighNut].Start := StartP; + if IlNut = 1 then begin + StartNote := Nuta[HighNut].Start; + if Czesci[NrCzesci].Ilosc = 1 then + Start := -100; +// Start := Nuta[HighNut].Start; + end; + + Nuta[HighNut].Dlugosc := DurationP; + Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Nuta[HighNut].Wartosc := 0; + ':': Nuta[HighNut].Wartosc := 1; + '*': Nuta[HighNut].Wartosc := 2; + end; + + Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; + + Nuta[HighNut].Ton := NoteP; + if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; + Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; + + Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); + Lyric := Lyric + Nuta[HighNut].Tekst; + + if TypeP = 'F' then + Nuta[HighNut].FreeStyle := true; + + Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; + end; // with +end; + +//-------------------- +// Called when a new Sentence is found in the TXT File +//-------------------- +procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); +var +I: Integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); + + //Total Notes Patch + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; + for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); + Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; + Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; + + if not AktSong.Relative then + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + + if AktSong.Relative then begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; + end; + + Base[NrCzesciP] := 100; // high number +end; +//-------------------- +// Load a Song +//-------------------- +function LoadSong(Name: string): boolean; +var + TempC: char; + Tekst: string; + CP: integer; // Current Player (0 or 1) + Pet: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Name) then begin + Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci'); + exit; + end; + + try + MultBPM := 4; // 4 - mnoznik dla czasu nut + Mult := 1; // 4 - dokladnosc pomiaru nut + Base[0] := 100; // high number +// Base[1] := 100; // high number + Czesci[0].Wartosc := 0; +// Czesci[1].Wartosc := 0; // here was the error in 0.3.2 + AktSong.Relative := false; + + Rel[0] := 0; +// Rel[1] := 0; + CP := 0; + Both := false; + if Length(Player) = 2 then Both := true; + + FileMode := fmOpenRead; + AssignFile(SongFile, Name); + Reset(SongFile); + + //Clear old Song Header + ClearSong(AktSong); + + if (AktSong.Path = '') then + AktSong.Path := ExtractFilePath(Name); + + if (AktSong.FileName = '') then + AktSong.Filename := ExtractFileName(Name); + //Read Header + Result := ReadTxTHeader(AktSong); + if not Result then + begin + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Tekst); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + Log.LogError('Could not load txt File, no Notes found: ' + Name); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Czesci, 2); + for Pet := 0 to High(Czesci) do begin + SetLength(Czesci[Pet].Czesc, 1); + Czesci[Pet].High := 0; + Czesci[Pet].Ilosc := 1; + Czesci[Pet].Akt := 0; + Czesci[Pet].Resolution := AktSong.Resolution; + Czesci[Pet].NotesGAP := AktSong.NotesGAP; + Czesci[Pet].Czesc[0].IlNut := 0; + Czesci[Pet].Czesc[0].HighNut := -1; + end; + +// TempC := ':'; +// TempC := Tekst[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do begin + Inc(FileLineNo); + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // wczytuje nute + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + // dodaje nute + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; // if + if TempC = '-' then begin + // reads sentence + Read(SongFile, Param1); + if AktSong.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + + end; // if + + if TempC = 'B' then begin + SetLength(AktSong.BPM, Length(AktSong.BPM) + 1); + Read(SongFile, AktSong.BPM[High(AktSong.BPM)].StartBeat); + AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then begin + Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; + Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); + //Total Notes Patch + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; + for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do + begin + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end else begin + for Pet := 0 to High(Czesci) do begin + Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; + Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); + //Total Notes Patch + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; + for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do + begin + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end; + end; + + Read(SongFile, TempC); + end; // while} + + CloseFile(SongFile); + except + Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + +//-------------------- +// Saves a Song +//-------------------- +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + B: integer; + RelativeSubTime: integer; + NoteState: String; + +begin +// Relative := true; // override (idea - use shift+S to save with relative) + AssignFile(SongFile, Name); + Rewrite(SongFile); + + WriteLn(SongFile, '#TITLE:' + Song.Title + ''); + WriteLn(SongFile, '#ARTIST:' + Song.Artist); + + if Song.Creator <> '' then WriteLn(SongFile, '#CREATOR:' + Song.Creator); + if Song.Edition <> 'Unknown' then WriteLn(SongFile, '#EDITION:' + Song.Edition); + if Song.Genre <> 'Unknown' then WriteLn(SongFile, '#GENRE:' + Song.Genre); + if Song.Language <> 'Unknown' then WriteLn(SongFile, '#LANGUAGE:' + Song.Language); + if Song.Cover <> '' then WriteLn(SongFile, '#COVER:' + Song.Cover); + + WriteLn(SongFile, '#MP3:' + Song.Mp3); + + if Song.Background <> '' then WriteLn(SongFile, '#BACKGROUND:' + Song.Background); + if Song.Video <> '' then WriteLn(SongFile, '#VIDEO:' + Song.Video); + if Song.VideoGAP <> 0 then WriteLn(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then WriteLn(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then WriteLn(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then WriteLn(SongFile, '#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then WriteLn(SongFile, '#END:' + IntToStr(Song.Finish)); + if Relative then WriteLn(SongFile, '#RELATIVE:yes'); + + WriteLn(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + WriteLn(SongFile, '#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(AktSong.BPM) do + WriteLn(SongFile, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4)); + + for C := 0 to Czesc.High do begin + for N := 0 to Czesc.Czesc[C].HighNut do begin + with Czesc.Czesc[C].Nuta[N] do begin + + + //Golden + Freestyle Note Patch + case Czesc.Czesc[C].Nuta[N].Wartosc of + 0: NoteState := 'F '; + 1: NoteState := ': '; + 2: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst; + + + WriteLn(SongFile, S); + end; // with + end; // N + + if C < Czesc.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start) + else begin + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime); + RelativeSubTime := Czesc.Czesc[C+1].Start; + end; + WriteLn(SongFile, S); + end; + + end; // C + + + WriteLn(SongFile, 'E'); + CloseFile(SongFile); +end; end. \ No newline at end of file diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index cafbc912..f12e3832 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -147,7 +147,7 @@ const IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); implementation -uses UPliki, SDL, ULanguage, USkins, URecord; +uses UFiles, SDL, ULanguage, USkins, URecord; procedure TIni.Load; var diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index b911b90a..4649c089 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -36,7 +36,7 @@ var implementation -uses UPliki, UIni, IniFiles, Classes, SysUtils, Windows, ULog; +uses UFiles, UIni, IniFiles, Classes, SysUtils, Windows, ULog; //---------- //Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 0b492cb3..59e25954 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -47,7 +47,7 @@ var Log: TLog; implementation -uses UPliki, SysUtils, DateUtils, URecord, UTime, UIni, Windows; +uses UFiles, SysUtils, DateUtils, URecord, UTime, UIni, Windows; destructor TLog.Free; begin diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 0e4e4ddd..6e997c11 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -199,7 +199,7 @@ const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); implementation -uses UGraphic, URecord, UPliki, UIni, UMain, UThemes; +uses UGraphic, URecord, UFiles, UIni, UMain, UThemes; procedure InitializeSound; begin diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 15e17047..67460ed7 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -58,7 +58,7 @@ type implementation -uses USongs, ULog, UPliki, UGraphic, UThemes, SysUtils; +uses USongs, ULog, UFiles, UGraphic, UThemes, SysUtils; //---------- //Create - Construct Class - Dummy for now diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 4b49127c..edf5b6df 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -96,7 +96,7 @@ var implementation -uses UPliki, UIni, UFiles, StrUtils; +uses UFiles, UIni, StrUtils; procedure TSongs.LoadSongList; begin -- cgit v1.2.3 From fb785ffee0bc3e1db1022a2c8286f5b9f8944b37 Mon Sep 17 00:00:00 2001 From: mota23 Date: Thu, 17 May 2007 01:10:39 +0000 Subject: Added: New Options/Advanced item "auto party-menu": Switches automatic popup-menu in party-mode on/off. "on" is better usability for joypad, "off" for keyboard. Changed: Keys in Party Song Selection, "m" is popup-menu and "enter" direkt to singscreen. Added: new Statics and Texts to UScreenSong, 2 sets, one for "normal" the other for party-mode. Added: dismissed sound for party-mode. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@202 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 9 ++++++ Game/Code/Classes/UThemes.pas | 71 +++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 78 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index f12e3832..ca7afe9a 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -63,6 +63,7 @@ type AskbeforeDel: integer; OnSongClick: integer; LineBonus: integer; + PartyPopup: integer; // Controller Joypad: integer; @@ -140,6 +141,7 @@ const IAskbeforeDel: array[0..1] of string = ('Off', 'On'); IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); IJoypad: array[0..1] of string = ('Off', 'On'); ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); @@ -455,6 +457,10 @@ begin for Pet := 0 to High(ILineBonus) do if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + // PartyPopup + Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); + for Pet := 0 to High(IPartyPopup) do + if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; // Joypad @@ -638,6 +644,9 @@ begin Tekst := ILineBonus[Ini.LineBonus]; IniFile.WriteString('Advanced', 'LineBonus', Tekst); + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); // Joypad Tekst := IJoypad[Ini.Joypad]; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index b9183740..24ac0eaa 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -297,10 +297,38 @@ type StaticTeam3Joker4: TThemeStatic; StaticTeam3Joker5: TThemeStatic; - - StaticKeys1 : TThemeStatic; TextKeys1 : TThemeText; + StaticKeys1Party : TThemeStatic; + TextKeys1Party : TThemeText; + StaticKeys2 : TThemeStatic; + TextKeys2 : TThemeText; + StaticKeys2Party : TThemeStatic; + TextKeys2Party : TThemeText; + StaticKeys3 : TThemeStatic; + TextKeys3 : TThemeText; + StaticKeys3Party : TThemeStatic; + TextKeys3Party : TThemeText; + StaticKeys4 : TThemeStatic; + TextKeys4 : TThemeText; + StaticKeys4Party : TThemeStatic; + TextKeys4Party : TThemeText; + StaticKeys5 : TThemeStatic; + TextKeys5 : TThemeText; + StaticKeys5Party : TThemeStatic; + TextKeys5Party : TThemeText; + StaticKeys6 : TThemeStatic; + TextKeys6 : TThemeText; + StaticKeys6Party : TThemeStatic; + TextKeys6Party : TThemeText; + StaticKeys7 : TThemeStatic; + TextKeys7 : TThemeText; + StaticKeys7Party : TThemeStatic; + TextKeys7Party : TThemeText; + StaticKeys8 : TThemeStatic; + TextKeys8 : TThemeText; + StaticKeys8Party : TThemeStatic; + TextKeys8Party : TThemeText; end; @@ -473,6 +501,7 @@ type SelectLineBonus: TThemeSelect; SelectAskbeforeDel: TThemeSelect; SelectOnSongClick: TThemeSelectSlide; + SelectPartyPopup: TThemeSelect; ButtonExit: TThemeButton; end; @@ -1014,6 +1043,43 @@ begin ThemeLoadStatic(Song.StaticKeys1, 'SongStaticKeys1'); ThemeLoadText(Song.TextKeys1, 'SongStaticKeys1Text'); + ThemeLoadStatic(Song.StaticKeys1Party, 'SongStaticKeys1Party'); + ThemeLoadText(Song.TextKeys1Party, 'SongStaticKeys1TextParty'); + + ThemeLoadStatic(Song.StaticKeys2, 'SongStaticKeys2'); + ThemeLoadText(Song.TextKeys2, 'SongStaticKeys2Text'); + ThemeLoadStatic(Song.StaticKeys2Party, 'SongStaticKeys2Party'); + ThemeLoadText(Song.TextKeys2Party, 'SongStaticKeys2TextParty'); + + ThemeLoadStatic(Song.StaticKeys3, 'SongStaticKeys3'); + ThemeLoadText(Song.TextKeys3, 'SongStaticKeys3Text'); + ThemeLoadStatic(Song.StaticKeys3Party, 'SongStaticKeys3Party'); + ThemeLoadText(Song.TextKeys3Party, 'SongStaticKeys3TextParty'); + + ThemeLoadStatic(Song.StaticKeys4, 'SongStaticKeys4'); + ThemeLoadText(Song.TextKeys4, 'SongStaticKeys4Text'); + ThemeLoadStatic(Song.StaticKeys4Party, 'SongStaticKeys4Party'); + ThemeLoadText(Song.TextKeys4Party, 'SongStaticKeys4TextParty'); + + ThemeLoadStatic(Song.StaticKeys5, 'SongStaticKeys5'); + ThemeLoadText(Song.TextKeys5, 'SongStaticKeys5Text'); + ThemeLoadStatic(Song.StaticKeys5Party, 'SongStaticKeys5Party'); + ThemeLoadText(Song.TextKeys5Party, 'SongStaticKeys5TextParty'); + + ThemeLoadStatic(Song.StaticKeys6, 'SongStaticKeys6'); + ThemeLoadText(Song.TextKeys6, 'SongStaticKeys6Text'); + ThemeLoadStatic(Song.StaticKeys6Party, 'SongStaticKeys6Party'); + ThemeLoadText(Song.TextKeys6Party, 'SongStaticKeys6TextParty'); + + ThemeLoadStatic(Song.StaticKeys7, 'SongStaticKeys7'); + ThemeLoadText(Song.TextKeys7, 'SongStaticKeys7Text'); + ThemeLoadStatic(Song.StaticKeys7Party, 'SongStaticKeys7Party'); + ThemeLoadText(Song.TextKeys7Party, 'SongStaticKeys7TextParty'); + + ThemeLoadStatic(Song.StaticKeys8, 'SongStaticKeys8'); + ThemeLoadText(Song.TextKeys8, 'SongStaticKeys8Text'); + ThemeLoadStatic(Song.StaticKeys8Party, 'SongStaticKeys8Party'); + ThemeLoadText(Song.TextKeys8Party, 'SongStaticKeys8TextParty'); // Sing ThemeLoadBasic(Sing, 'Sing'); @@ -1209,6 +1275,7 @@ begin ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadSelect (OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); //error and check popup -- cgit v1.2.3 From f11d9806f4623dc4dbf14e521624109b7a69b86b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 17 May 2007 10:33:27 +0000 Subject: Deleted Motas Methods to display variable Statics and Texts in Party Mode. Added a new, more extendable and easier in Code Method for displaying Statics in Party Mode or in Normal Mode only Enter in Songscreen in Party Mode Opens now SongMenu again when PartyPopup=1 Changed Theme to Fit these changes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@206 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 89 +++++++------------------------------------ 1 file changed, 14 insertions(+), 75 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 24ac0eaa..0fe207e9 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -280,6 +280,13 @@ type 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; @@ -296,41 +303,6 @@ type StaticTeam3Joker3: TThemeStatic; StaticTeam3Joker4: TThemeStatic; StaticTeam3Joker5: TThemeStatic; - - StaticKeys1 : TThemeStatic; - TextKeys1 : TThemeText; - StaticKeys1Party : TThemeStatic; - TextKeys1Party : TThemeText; - StaticKeys2 : TThemeStatic; - TextKeys2 : TThemeText; - StaticKeys2Party : TThemeStatic; - TextKeys2Party : TThemeText; - StaticKeys3 : TThemeStatic; - TextKeys3 : TThemeText; - StaticKeys3Party : TThemeStatic; - TextKeys3Party : TThemeText; - StaticKeys4 : TThemeStatic; - TextKeys4 : TThemeText; - StaticKeys4Party : TThemeStatic; - TextKeys4Party : TThemeText; - StaticKeys5 : TThemeStatic; - TextKeys5 : TThemeText; - StaticKeys5Party : TThemeStatic; - TextKeys5Party : TThemeText; - StaticKeys6 : TThemeStatic; - TextKeys6 : TThemeText; - StaticKeys6Party : TThemeStatic; - TextKeys6Party : TThemeText; - StaticKeys7 : TThemeStatic; - TextKeys7 : TThemeText; - StaticKeys7Party : TThemeStatic; - TextKeys7Party : TThemeText; - StaticKeys8 : TThemeStatic; - TextKeys8 : TThemeText; - StaticKeys8Party : TThemeStatic; - TextKeys8Party : TThemeText; - - end; TThemeSing = class(TThemeBasic) @@ -1022,6 +994,13 @@ begin 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'); @@ -1041,46 +1020,6 @@ begin ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); - ThemeLoadStatic(Song.StaticKeys1, 'SongStaticKeys1'); - ThemeLoadText(Song.TextKeys1, 'SongStaticKeys1Text'); - ThemeLoadStatic(Song.StaticKeys1Party, 'SongStaticKeys1Party'); - ThemeLoadText(Song.TextKeys1Party, 'SongStaticKeys1TextParty'); - - ThemeLoadStatic(Song.StaticKeys2, 'SongStaticKeys2'); - ThemeLoadText(Song.TextKeys2, 'SongStaticKeys2Text'); - ThemeLoadStatic(Song.StaticKeys2Party, 'SongStaticKeys2Party'); - ThemeLoadText(Song.TextKeys2Party, 'SongStaticKeys2TextParty'); - - ThemeLoadStatic(Song.StaticKeys3, 'SongStaticKeys3'); - ThemeLoadText(Song.TextKeys3, 'SongStaticKeys3Text'); - ThemeLoadStatic(Song.StaticKeys3Party, 'SongStaticKeys3Party'); - ThemeLoadText(Song.TextKeys3Party, 'SongStaticKeys3TextParty'); - - ThemeLoadStatic(Song.StaticKeys4, 'SongStaticKeys4'); - ThemeLoadText(Song.TextKeys4, 'SongStaticKeys4Text'); - ThemeLoadStatic(Song.StaticKeys4Party, 'SongStaticKeys4Party'); - ThemeLoadText(Song.TextKeys4Party, 'SongStaticKeys4TextParty'); - - ThemeLoadStatic(Song.StaticKeys5, 'SongStaticKeys5'); - ThemeLoadText(Song.TextKeys5, 'SongStaticKeys5Text'); - ThemeLoadStatic(Song.StaticKeys5Party, 'SongStaticKeys5Party'); - ThemeLoadText(Song.TextKeys5Party, 'SongStaticKeys5TextParty'); - - ThemeLoadStatic(Song.StaticKeys6, 'SongStaticKeys6'); - ThemeLoadText(Song.TextKeys6, 'SongStaticKeys6Text'); - ThemeLoadStatic(Song.StaticKeys6Party, 'SongStaticKeys6Party'); - ThemeLoadText(Song.TextKeys6Party, 'SongStaticKeys6TextParty'); - - ThemeLoadStatic(Song.StaticKeys7, 'SongStaticKeys7'); - ThemeLoadText(Song.TextKeys7, 'SongStaticKeys7Text'); - ThemeLoadStatic(Song.StaticKeys7Party, 'SongStaticKeys7Party'); - ThemeLoadText(Song.TextKeys7Party, 'SongStaticKeys7TextParty'); - - ThemeLoadStatic(Song.StaticKeys8, 'SongStaticKeys8'); - ThemeLoadText(Song.TextKeys8, 'SongStaticKeys8Text'); - ThemeLoadStatic(Song.StaticKeys8Party, 'SongStaticKeys8Party'); - ThemeLoadText(Song.TextKeys8Party, 'SongStaticKeys8TextParty'); - // Sing ThemeLoadBasic(Sing, 'Sing'); -- cgit v1.2.3 From d52cb874cd39eac4a4aff100c22bf3280eea4275 Mon Sep 17 00:00:00 2001 From: mota23 Date: Thu, 17 May 2007 14:04:07 +0000 Subject: added: Video Icon. Shows if Video is present in Song-Selection. Needs to be fixed. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@212 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 0fe207e9..471e46bf 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -249,7 +249,10 @@ type TextTitle: TThemeText; TextNumber: TThemeText; - //Show Cat in TopLeft Mod + //Video Icon Mod + VideoIcon: TThemeStatic; + + //Show Cat in TopLeft Mod TextCat: TThemeText; StaticCat: TThemeStatic; @@ -280,6 +283,7 @@ type ColR, ColG, ColB: Real; end; + //Party and Non Party specific Statics and Texts StaticParty: AThemeStatic; TextParty: AThemeText; @@ -303,6 +307,8 @@ type StaticTeam3Joker3: TThemeStatic; StaticTeam3Joker4: TThemeStatic; StaticTeam3Joker5: TThemeStatic; + + end; TThemeSing = class(TThemeBasic) @@ -959,6 +965,9 @@ begin 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'); @@ -1020,6 +1029,7 @@ begin ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); + // Sing ThemeLoadBasic(Sing, 'Sing'); -- cgit v1.2.3 From 1858dadeadf071bbc3eb16ae835fc9bd95440eab Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 17 May 2007 14:23:38 +0000 Subject: Video Tag will now only be read when the VideoFile exists. -> Better usability of VideoIcon git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@214 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 912a476d..aa336233 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -239,7 +239,7 @@ begin end // Video File - else if (Identifier = 'VIDEO') then + else if (Identifier = 'VIDEO') AND (FileExists(Song.Path + Value)) then begin Song.Video := Value; end -- cgit v1.2.3 From 56ce1cf3c09f0ebad019bb1f158d335e41f3d2d6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 18 May 2007 10:54:33 +0000 Subject: Removed Debug Message from UIni, showing the saved SoundCard Entrys git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@218 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index ca7afe9a..f3ea84ac 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -616,7 +616,7 @@ begin IniFile.WriteString('Record', 'ChannelR' + S, Tekst); end; - Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); //Advanced Settings -- cgit v1.2.3 From 4f7f9544e5dbf992599865243aee4c6e2a5b5f8e Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 18 May 2007 10:55:28 +0000 Subject: Added ability to take a Screenshot with the Print Key from every Screen in the Game git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@219 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 47860198..3bf7d197 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -160,13 +160,16 @@ Begin End; // With} SDL_KEYDOWN: begin + //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path + if (Event.key.keysym.sym = SDLK_SYSREQ) then + Display.ScreenShot + // popup hack... if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - // end of popup hack else -- cgit v1.2.3 From 7bf5487faf2b099ced0b2126c2cca164be80acf1 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 18 May 2007 10:57:17 +0000 Subject: Some changes mode on ModiSDK and Depending Files(Plugin Loader, Party SingScreen and Plugins) Changes make the Pluginsystem more extendable with backwards compatibility in further Versions. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@220 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDLLManager.pas | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 59c75d5b..4b8838b9 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -25,7 +25,7 @@ type function LoadPlugin(No: Cardinal): boolean; procedure UnLoadPlugin; - function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: fModi_PlaySound): boolean; + function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; function PluginFinish (var Playerinfo: TPlayerinfo): byte; procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); @@ -75,6 +75,9 @@ end; procedure TDLLMan.ClearPluginInfo(No: Cardinal); begin + //Set to Party Modi Plugin + Plugins[No].Typ := 8; + Plugins[No].Name := 'unknown'; Plugins[No].NumPlayers := 0; @@ -183,12 +186,19 @@ if (hLib <> 0) then @P_RData := nil; end; -function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: fModi_PlaySound): boolean; +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; +var + Methods: TMethodRec; begin -if (@P_Init <> nil) then - Result := P_Init (TeamInfo, PlayerInfo, Sentences, LoadTex, Print, LoadSound, PlaySound) -else - Result := False + Methods.LoadTex := LoadTex; + Methods.Print := Print; + Methods.LoadSound := LoadSound; + Methods.PlaySound := PlaySound; + + if (@P_Init <> nil) then + Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) + else + Result := False end; function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; -- cgit v1.2.3 From 0df43e29d3d12f93fd4ace638cfb60b65dd32262 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 23 May 2007 17:00:52 +0000 Subject: Fixed a Bug that can cause the application crashes, when Song Data is missing. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@226 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index aa336233..ee1935cd 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -239,9 +239,12 @@ begin end // Video File - else if (Identifier = 'VIDEO') AND (FileExists(Song.Path + Value)) then + else if (Identifier = 'VIDEO') then begin - Song.Video := Value; + if (FileExists(Song.Path + Value)) then + Song.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + Song.Path + Song.FileName); end // Video Gap @@ -579,6 +582,7 @@ begin Result := ReadTxTHeader(AktSong); if not Result then begin + CloseFile(SongFile); Log.LogError('Error Loading SongHeader, abort Song Loading'); Exit; end; @@ -594,6 +598,7 @@ begin if (EoF(SongFile)) then begin //Song File Corrupted - No Notes + CloseFile(SongFile); Log.LogError('Could not load txt File, no Notes found: ' + Name); Result := False; Exit; @@ -617,7 +622,6 @@ begin // TempC := Tekst[1]; // read from backup variable, don't use default ':' value while (TempC <> 'E') AND (not EOF(SongFile)) do begin - Inc(FileLineNo); if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin // wczytuje nute Read(SongFile, Param1); @@ -688,10 +692,17 @@ begin end; Read(SongFile, TempC); + Inc(FileLineNo); end; // while} CloseFile(SongFile); except + try + CloseFile(SongFile); + except + + end; + Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(FileLineNo)); exit; end; -- cgit v1.2.3 From 3789f80943f7a237ecbcadeee5803a1fa4a982a2 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 28 May 2007 19:57:46 +0000 Subject: Fixed some Pronounciation in Error Messages git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@235 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index ee1935cd..5214a9b3 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -336,8 +336,8 @@ begin if (Done <> 15) then begin Result := False; - if (Done and 8) = 0 then //No BMP Flag - Log.LogError('BMP Tag Missing: ' + Song.FileName) + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + Song.FileName) else if (Done and 4) = 0 then //No MP3 Flag Log.LogError('MP3 Tag/File Missing: ' + Song.FileName) else if (Done and 2) = 0 then //No Artist Flag -- cgit v1.2.3 From 2648bf52507205e7b00898cf2f5b6a3eb40e2229 Mon Sep 17 00:00:00 2001 From: mota23 Date: Tue, 29 May 2007 16:57:11 +0000 Subject: Added: Support for Player Name Templates. Set Names in config.ini ([NameTemplate], Name1..12=text and recall in Name-Screens with F1..F12. Fix: All 12 player- and 3 teamnames are now saved in config.ini git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@237 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index f3ea84ac..c92a7a50 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -5,7 +5,11 @@ uses IniFiles, ULog, SysUtils; type TIni = class - Name: array[0..5] of string; + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; // Game Players: integer; @@ -174,9 +178,16 @@ begin IniFile := TMemIniFile.Create(GamePath + 'config.ini'); // Name - for I := 0 to 5 do + for I := 0 to 11 do Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + // Templates for Names Mod + for I := 0 to 2 do + Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + // Players Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); for Pet := 0 to High(IPlayers) do @@ -665,8 +676,13 @@ begin IniFile := TIniFile.Create(GamePath + 'config.ini'); //Name - for I := 1 to 6 do + // Templates for Names Mod + for I := 1 to 12 do IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); IniFile.Free; end; -- cgit v1.2.3 From 842794d7b93443626089c00083118b532105c5ac Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 1 Jun 2007 17:40:09 +0000 Subject: Fixed standard Cover position. Buttons that have no expression in Theme are now hidden. The Screens are still available through Hotkeys, but they have supposably also no expression in Theme. => Better compatibility with old Screens git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@241 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 471e46bf..ef5d1136 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -974,7 +974,7 @@ begin //Load Cover Pos and Size from Theme Mod Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); - Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 140); + 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); @@ -1589,6 +1589,11 @@ var T: integer; Collections2: PAThemeButtonCollection; begin + if not ThemeIni.SectionExists(Name) then + begin + ThemeButton.Visible := False; + exit; + end; DecimalSeparator := '.'; ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0); -- cgit v1.2.3 From 514ece97aaeb8eaa8bf56e224826bc5e6169ce8b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 3 Jun 2007 19:00:14 +0000 Subject: Some Code Cleanup in UScreenSong Add Procedure DeletePlaylist to TPlaylistManager Add automatic Playlist Deleting if last Song is deleted Fixed some Cover displaying Bugs when JumptoMenu is left git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@242 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 84 +++++++++++++++++++++++++++++++++-------- 1 file changed, 68 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 67460ed7..55cf90ff 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -40,6 +40,7 @@ type Procedure SetPlayList(Index: Cardinal); Function AddPlaylist(Name: String): Cardinal; + Procedure DelPlaylist(const Index: Cardinal); Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); @@ -197,27 +198,29 @@ begin //open File for Rewriting AssignFile(F, PlaylistPath + Playlists[Index].Filename); try - Rewrite(F); + try + Rewrite(F); - //Write Version (not nessecary but helpful) - WriteLn(F, '######################################'); - WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); - WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); - WriteLn(F, '######################################'); + //Write Version (not nessecary but helpful) + WriteLn(F, '######################################'); + WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); + WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); + WriteLn(F, '######################################'); - //Write Name Information - WriteLn(F, '#Name: ' + Playlists[Index].Name); + //Write Name Information + WriteLn(F, '#Name: ' + Playlists[Index].Name); - //Write Song Information - WriteLn(F, '#Songs:'); + //Write Song Information + WriteLn(F, '#Songs:'); - For I := 0 to high(Playlists[Index].Items) do - begin - WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + For I := 0 to high(Playlists[Index].Items) do + begin + WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + end; + except + log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); end; - finally - log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); CloseFile(F); end; end; @@ -247,6 +250,9 @@ begin CatSongs.CatNumShow := -3; Mode := 2; + //Set CurPlaylist + CurPlaylist := Index; + //Show Cat in Topleft: ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); @@ -286,6 +292,47 @@ begin SavePlayList(Result); end; +//---------- +//DelPlaylist - Deletes a Playlist +//---------- +Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); +var + I: Integer; + Filename: String; +begin + If Index > High(Playlists) then + Exit; + + Filename := PlaylistPath + Playlists[Index].Filename; + + //If not FileExists or File is not Writeable then exit + If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then + Exit; + + + //Delete Playlist from FileSystem + if Not DeleteFile(Filename) then + Exit; + + //Delete Playlist from Array + //move all PLs to the Hole + For I := Index to High(Playlists)-1 do + PlayLists[I] := PlayLists[I+1]; + + //Delete last Playlist + SetLength (Playlists, High(Playlists)); + + //If Playlist is Displayed atm + //-> Display Songs + if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then + begin + ScreenSong.UnLoadDetailedCover; + CatSongs.SetFilter('', 0); + ScreenSong.Interaction := 0; + ScreenSong.FixSelected; + end; +end; + //---------- //AddItem - Adds an Item to a specific Playlist //---------- @@ -347,8 +394,13 @@ begin SavePlayList(P); end; + //Delete Playlist if Last Song is deleted + if (Length(PlayLists[P].Items) = 0) then + begin + DelPlaylist(P); + end //Correct Display when Editing current Playlist - if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then SetPlaylist(P); end; -- cgit v1.2.3 From 49ada15c935658c5d90416e26acfb360f1e7c047 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 3 Jun 2007 19:45:43 +0000 Subject: Added SongPreview Fading Song Preview Max Volume is now 70 % Need Testing because of timing git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@243 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 6e997c11..52bae3c9 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -59,6 +59,7 @@ type procedure InitializePlayback; procedure InitializeRecord; procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: Byte); procedure SetLoop(Enabled: boolean); function Open(Name: string): boolean; // true if succeed procedure Rewind; @@ -350,6 +351,16 @@ begin BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); end; +procedure TMusic.SetMusicVolume(Volume: Byte); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + //Set Volume + BASS_ChannelSetAttributes (Bass, -1, Integer(Volume), -101); +end; + procedure TMusic.SetLoop(Enabled: boolean); begin Loop := Enabled; @@ -364,6 +375,8 @@ begin Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); Loaded := true; + //Set Max Volume + SetMusicVolume (100); end; Result := Loaded; -- cgit v1.2.3 From d08356e3b64d8738ff9672229c1bbe963b58337c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 6 Jun 2007 20:24:29 +0000 Subject: Fixed some Bugs in Song Fading Added Ini Values to change the Fading and the Preview Volume git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@245 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 26 ++++++++++++++++++++++++-- Game/Code/Classes/UMusic.pas | 6 +++--- 2 files changed, 27 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index c92a7a50..528966b3 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -38,7 +38,10 @@ type BeatClick: integer; SavePlayback: integer; Threshold: integer; - //TwoPlayerMode: integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; // Lyrics LyricsFont: integer; @@ -130,7 +133,10 @@ const IBeatClick: array[0..1] of string = ('Off', 'On'); ISavePlayback: array[0..1] of string = ('Off', 'On'); IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - //ITwoPlayerMode: array[0..2] of string = ('Stereo', '2 Cards', 'Advanced'); + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); @@ -316,6 +322,15 @@ begin for Pet := 0 to High(IThreshold) do if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + //Song Preview + Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); + for Pet := 0 to High(IPreviewVolume) do + if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; + + Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); + for Pet := 0 to High(IPreviewFading) do + if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; + // Lyrics Font Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); for Pet := 0 to High(ILyricsFont) do @@ -582,6 +597,13 @@ begin Tekst := IThreshold[Ini.Threshold]; IniFile.WriteString('Sound', 'Threshold', Tekst); + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); + // SavePlayback Tekst := ISavePlayback[Ini.SavePlayback]; IniFile.WriteString('Sound', 'SavePlayback', Tekst); diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 52bae3c9..3fcd2a21 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -59,7 +59,7 @@ type procedure InitializePlayback; procedure InitializeRecord; procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: Byte); + procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); function Open(Name: string): boolean; // true if succeed procedure Rewind; @@ -351,14 +351,14 @@ begin BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); end; -procedure TMusic.SetMusicVolume(Volume: Byte); +procedure TMusic.SetMusicVolume(Volume: Integer); begin //Max Volume Prevention if Volume > 100 then Volume := 100; //Set Volume - BASS_ChannelSetAttributes (Bass, -1, Integer(Volume), -101); + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); end; procedure TMusic.SetLoop(Enabled: boolean); -- cgit v1.2.3 From 7518565b2c77b915e8fe4f693f8de161d7506859 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 6 Jun 2007 20:26:59 +0000 Subject: Made new Player BG and Score Objects in ScreenSing backwards compatible git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@246 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 38 ++++++++++++++++++++++++++++++-------- 1 file changed, 30 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index ef5d1136..8a6a7b9b 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -1053,16 +1053,38 @@ begin ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); //Added for ps3 skin //This one is shown in 2/4P mode - ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); - ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); - ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); - ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + //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 - ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); - ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); - ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); - ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + //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'); -- cgit v1.2.3 From 4131257e42ceb88fa4fb2849b5c40011e8b5635d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 8 Jun 2007 16:23:40 +0000 Subject: Added ability to delete a Playlist within the Menu Language Files updated git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@248 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 55cf90ff..e3f68239 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -327,9 +327,11 @@ begin if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then begin ScreenSong.UnLoadDetailedCover; + ScreenSong.HideCatTL; CatSongs.SetFilter('', 0); ScreenSong.Interaction := 0; ScreenSong.FixSelected; + ScreenSong.ChangeMusic; end; end; -- cgit v1.2.3 From 141878175d76d013be3ec8fb9fd0a58dc9b0d3eb Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 9 Jun 2007 10:10:25 +0000 Subject: Added Preview Volume and Fading to Sound Options Changed Themes to Fit these changes Updated Language Files Some fixes in SelectSlide git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@251 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 8a6a7b9b..78875dec 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -446,7 +446,9 @@ type SelectClickAssist: TThemeSelect; SelectBeatClick: TThemeSelect; SelectThreshold: TThemeSelect; - //SelectTwoPlayerMode: TThemeSelect; + //Song Preview + SelectSlidePreviewVolume: TThemeSelectSlide; + SelectSlidePreviewFading: TThemeSelectSlide; ButtonExit: TThemeButton; end; @@ -1209,7 +1211,10 @@ begin ThemeLoadSelect(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); - //ThemeLoadSelect(OptionsSound.SelectTwoPlayerMode, 'OptionsSoundSelectTwoPlayerMode'); + //Song Preview + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); // Options Lyrics -- cgit v1.2.3 From 155910dbe253d5c1bf8e2287c27f0d9dffefa383 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 10 Jun 2007 09:12:53 +0000 Subject: Added a workaround for EInvalidPointer Exception when a not existing Equalizer- Color is specified in Theme git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@254 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 78875dec..079ceb00 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -1002,6 +1002,11 @@ 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 -- cgit v1.2.3 From 81b634fd2e0b9a70c43e12d17d2ca25cce1a7335 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 10 Jun 2007 10:38:34 +0000 Subject: Changed LineBonus Translations to 0.5.3 compatible Texts git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@255 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 079ceb00..dbb637e4 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -1109,15 +1109,15 @@ begin ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); //Line Bonus Texts - Sing.LineBonusText[0] := Language.Translate('LINEBONUS_WORST'); + Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL'); Sing.LineBonusText[1] := Sing.LineBonusText[0]; - Sing.LineBonusText[2] := Language.Translate('LINEBONUS_BAD'); - Sing.LineBonusText[3] := Language.Translate('LINEBONUS_NORMAL'); - Sing.LineBonusText[4] := Sing.LineBonusText[3]; - Sing.LineBonusText[5] := Language.Translate('LINEBONUS_GOOD'); - Sing.LineBonusText[6] := Language.Translate('LINEBONUS_BETTER'); - Sing.LineBonusText[7] := Sing.LineBonusText[6]; - Sing.LineBonusText[8] := Language.Translate('LINEBONUS_PERFECT'); + 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'); // Score ThemeLoadBasic(Score, 'Score'); -- cgit v1.2.3 From 5d60d0893e283cd287ffc588774cbf8d995e19f3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 12 Jun 2007 16:55:47 +0000 Subject: Fixed a Bug in Database System thx to Pr3D@ToR git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@260 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDataBase.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index 0e5a4a3f..b8b41bc1 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -209,7 +209,7 @@ begin //Create Query Case Typ of 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `US_Scores` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; - 1: Query := 'SELECT `Player` , (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; + 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `US_Songs` ORDER BY `TimesPlayed`'; 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `US_Songs` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; end; @@ -252,7 +252,7 @@ begin 1:begin Stats[TableData.Row].Player := TableData.Fields[0]; - Stats[TableData.Row].AverageScore := TableData.FieldAsInteger(1); + Stats[TableData.Row].AverageScore := StrtoIntDef(TableData.Fields[1], 0); end; 2:begin -- cgit v1.2.3 From 077d1c500e6a90870dfa979303cd5003feffc359 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 20 Jun 2007 18:14:10 +0000 Subject: Enabled Deco Texurechanging depending on TeamPlaylings in PartyScore Screen Changed Theme to fit the Changes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@266 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index dbb637e4..b55a84dc 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -587,6 +587,23 @@ type StaticTeam3BG: TThemeStatic; StaticTeam3Deco: TThemeStatic; + DecoTextures: record + ChangeTextures: Boolean; + + FirstTexture: String; + FirstTyp: String; + FirstColor: String; + + SecondTexture: String; + SecondTyp: String; + SecondColor: String; + + ThirdTexture: String; + ThirdTyp: String; + ThirdColor: String; + end; + + TextWinner: TThemeText; end; @@ -1361,6 +1378,21 @@ begin 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 := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); + PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); + ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); //Party Win -- cgit v1.2.3 From 26173c50974c12b7ca6c9302efe6bd32c555df30 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jun 2007 12:27:58 +0000 Subject: Added ability to display Videos only in full size and Backgrounds in half size. Fullsize is now the standard value for Moviesize git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@268 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2 +- Game/Code/Classes/UIni.pas | 25 ++++++++++++++++++++----- 2 files changed, 21 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 41225c0d..2575758f 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -79,7 +79,7 @@ begin glClearColor (1, 1, 1, 1); glColor4f (1, 1, 1, 1); - if (Ini.MovieSize = 0) then //HalfSize BG + if (Ini.MovieSize <= 1) then //HalfSize BG begin (* half screen + gradient *) Rec.Top := 110; // 80 diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 528966b3..ceb3c240 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -126,7 +126,7 @@ const ISpectrum: array[0..1] of string = ('Off', 'On'); ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..1] of string = ('Half', 'Full'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); IClickAssist: array[0..1] of string = ('Off', 'On'); @@ -173,10 +173,10 @@ var Modes: PPSDL_Rect; SR: TSearchRec; //Skin List Patch -function GetFileName (S: String):String; + function GetFileName (S: String):String; begin //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); - Result := copy (S,0,Pos ('.ini',S)-1); + Result := copy (S,0,Pos ('.ini',S)-1); end; begin @@ -293,7 +293,7 @@ begin if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; // MovieSize - Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[0]); + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); for Pet := 0 to High(IMovieSize) do if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; @@ -349,12 +349,25 @@ begin // Theme //Theme List Patch + + //I2 Saves the no of the Deluxe (Standard-) Theme + I2 := 0; + //I counts is the cur. Theme no + I := 0; + SetLength(ITheme, 0); FindFirst('Themes\*.ini',faAnyFile,SR); Repeat + //Read Themename from Theme ThemeIni := TMemIniFile.Create(SR.Name); Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); ThemeIni.Free; + + //if Deluxe Theme then save Themeno to I2 + if (Tekst = 'DELUXE') then + I2 := I; + + //Search for Skins for this Theme for Pet := low(Skin.Skin) to high(Skin.Skin) do begin if UpperCase(Skin.Skin[Pet].Theme) = Tekst then @@ -364,6 +377,8 @@ begin break; end; end; + + Inc(I); Until FindNext(SR) <> 0; FindClose(SR); //Theme List Patch End } @@ -375,7 +390,7 @@ begin end; - Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[0]); + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); Ini.Theme := 0; for Pet := 0 to High(ITheme) do if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; -- cgit v1.2.3 From 139918027ecdd4a1b149722eea7b578579b993f1 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jun 2007 16:44:07 +0000 Subject: Fixed a Bug in Editor. When a Song with Cover was edited and after a song without was loaded and saved, the cover from the first song was written to the second song git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@269 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 5214a9b3..e6982a1a 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -116,6 +116,7 @@ begin //Additional Information Song.Background := ''; + Song.Cover := ''; Song.Video := ''; Song.VideoGAP := 0; Song.NotesGAP := 0; @@ -734,10 +735,10 @@ begin if Song.Edition <> 'Unknown' then WriteLn(SongFile, '#EDITION:' + Song.Edition); if Song.Genre <> 'Unknown' then WriteLn(SongFile, '#GENRE:' + Song.Genre); if Song.Language <> 'Unknown' then WriteLn(SongFile, '#LANGUAGE:' + Song.Language); - if Song.Cover <> '' then WriteLn(SongFile, '#COVER:' + Song.Cover); WriteLn(SongFile, '#MP3:' + Song.Mp3); + if Song.Cover <> '' then WriteLn(SongFile, '#COVER:' + Song.Cover); if Song.Background <> '' then WriteLn(SongFile, '#BACKGROUND:' + Song.Background); if Song.Video <> '' then WriteLn(SongFile, '#VIDEO:' + Song.Video); if Song.VideoGAP <> 0 then WriteLn(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); -- cgit v1.2.3 From 1d20a6ed1de519a7167c3b53fee7f2484f2f22b1 Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 26 Jun 2007 14:11:20 +0000 Subject: Added support for transparency in PNG images - if a PNG with transparency is loaded as 'Transparent' texture type, then the alpha-channel is set according to the transparency information in the file git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@270 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 0eae68a2..da603ec9 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -193,6 +193,10 @@ var TextureB: TBitmap; TextureJ: TJPEGImage; TexturePNG: TPNGObject; + TextureAlpha: array of byte; + AlphaPtr: PByte; + TransparentColor: TColor; + PixelColor: TColor; Pet: integer; Pet2: integer; @@ -246,6 +250,27 @@ begin Exit; end; TextureB.Assign(TexturePNG); + // transparent png hack start (part 1 of 2) + if (Typ = 'Transparent') and (TexturePNG.TransparencyMode = ptmPartial) then + begin + setlength(TextureAlpha, TextureB.Width*TextureB.Height); + if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or + (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then + begin + // i would have preferred english variables here but i use Pet because i'm lazy + for Pet := 0 to TextureB.Height - 1 do + begin + AlphaPtr := PByte(TexturePNG.AlphaScanline[Pet]); + for Pet2 := 0 to TextureB.Width - 1 do + begin + TextureAlpha[Pet*TextureB.Width+Pet2]:= AlphaPtr^; + Inc(AlphaPtr); + end; + end; + end; + end else + setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) + // transparent png hack end TexturePNG.Free; end; @@ -357,11 +382,13 @@ begin TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; + // kopiowanie for Pet := 0 to TexOrygH-1 do begin for Pet2 := 0 to TexOrygW-1 do begin Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - if ((Pix = $fefefe) or (Pix = Col)) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) + // ,- part of transparent png hack + if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; @@ -370,7 +397,12 @@ begin TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); - TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + // transparent png hack start (part 2 of 2) + if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin + TextureD32[Pet*TexNewW+Pet2+1,4]:=TextureAlpha[Pet*TexOrygW+Pet2]; + end else + // transparent png hack end + TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; end; end; end; -- cgit v1.2.3 From 7050f9d54fc4603a952c12efbab2e3331413865f Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 3 Jul 2007 08:37:09 +0000 Subject: some tweaking of transparency handling for PNGs to make it look more as expected git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@272 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index da603ec9..275f0748 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -206,6 +206,7 @@ var TempA: integer; Error: integer; SkipX: integer; + myAlpha: Real; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -399,7 +400,16 @@ begin TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); // transparent png hack start (part 2 of 2) if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - TextureD32[Pet*TexNewW+Pet2+1,4]:=TextureAlpha[Pet*TexOrygW+Pet2]; + myAlpha:=TextureAlpha[Pet*TexOrygW+Pet2]; + + // the following calculations tweak transparency so that it really looks transparent + myAlpha:=myAlpha-75; + if myAlpha < 0 then myAlpha:=0; + myAlpha:=myAlpha/180; + myAlpha:=myAlpha*myAlpha*myAlpha; + myAlpha:=myAlpha*255; + + TextureD32[Pet*TexNewW+Pet2+1,4]:=floor(myAlpha); end else // transparent png hack end TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; -- cgit v1.2.3 From dd3cc6f8e84f03f626a88741474412d36e4d18ac Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 8 Jul 2007 12:00:15 +0000 Subject: Improved Error Logging and Benchmark: Write US Version, date and time to files. Added better Commandline Parameter Interpreter: More than one parameter can be used at the same time Many new, useful farameters: e.g. No error logging, Resolution change, FullScreen, DualScreen Mode, other Config File, other Score File and SongPath git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@274 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 4 +- Game/Code/Classes/UGraphic.pas | 31 +++-- Game/Code/Classes/UIni.pas | 289 ++++++++++++++++++++++------------------- Game/Code/Classes/ULog.pas | 68 +++++----- Game/Code/Classes/UMain.pas | 4 +- 5 files changed, 216 insertions(+), 180 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 2575758f..077f5121 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -153,8 +153,8 @@ var begin; // Log.LogStatus('Oscilloscope', 'SingDraw'); glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } glBegin(GL_LINE_STRIP); glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 205fa9fd..cf1a0c5a 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -178,7 +178,7 @@ procedure LoadScreens; implementation -uses UMain, UIni, UDisplay, Graphics, Classes, Windows; +uses UMain, UIni, UDisplay, UCommandLine, Graphics, Classes, Windows; procedure LoadTextures; var @@ -332,8 +332,12 @@ var S: string; I: integer; W, H: integer; + Depth: Integer; begin - Screens := Ini.Screens + 1; + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); @@ -341,28 +345,39 @@ begin SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - S := IResolution[Ini.Resolution]; + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + I := Pos('x', S); W := StrToInt(Copy(S, 1, I-1)) * Screens; H := StrToInt(Copy(S, I+1, 1000)); - if ParamStr(1) = '-fsblack' then begin + {if ParamStr(1) = '-fsblack' then begin W := 800; H := 600; end; if ParamStr(1) = '-320x240' then begin W := 320; H := 240; - end; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); // SDL_SetRefreshrate(85); // SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - if (Ini.FullScreen = 0) and (ParamStr(1) <> '-fsblack') then - screen := SDL_SetVideoMode(W, H, (Ini.Depth+1) * 16, SDL_OPENGL) + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) else begin - screen := SDL_SetVideoMode(W, H, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); SDL_ShowCursor(0); end; if (screen = nil) then begin diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index ceb3c240..846c0deb 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -11,6 +11,9 @@ type NameTeam: array[0..2] of string; NameTemplate: array[0..11] of string; + //Filename of the opened iniFile + Filename: string; + // Game Players: integer; Difficulty: integer; @@ -159,7 +162,7 @@ const IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); implementation -uses UFiles, SDL, ULanguage, USkins, URecord; +uses UFiles, SDL, ULanguage, USkins, URecord, UCommandLine; procedure TIni.Load; var @@ -181,7 +184,16 @@ var begin GamePath := ExtractFilePath(ParamStr(0)); - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + if (Params.ConfigFile <> '') then + try + IniFile := TMemIniFile.Create(Params.ConfigFile); + except + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + end + else + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + // Name for I := 0 to 11 do @@ -516,9 +528,12 @@ begin // SongPath - SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); - + if (Params.SongPath <> '') then + SongPath := IncludeTrailingPathDelimiter(Params.SongPath) + else + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + Filename := IniFile.FileName; IniFile.Free; end; @@ -529,176 +544,178 @@ var I: Integer; S: String; begin - if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin - IniFile := TIniFile.Create(GamePath + 'config.ini'); + //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin - // Players - Tekst := IPlayers[Ini.Players]; - IniFile.WriteString('Game', 'Players', Tekst); + IniFile := TIniFile.Create(Filename); - // Difficulty - Tekst := IDifficulty[Ini.Difficulty]; - IniFile.WriteString('Game', 'Difficulty', Tekst); + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); - // Language - Tekst := ILanguage[Ini.Language]; - IniFile.WriteString('Game', 'Language', Tekst); + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); - // Tabs - Tekst := ITabs[Ini.Tabs]; - IniFile.WriteString('Game', 'Tabs', Tekst); + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); - // Sorting - Tekst := ISorting[Ini.Sorting]; - IniFile.WriteString('Game', 'Sorting', Tekst); + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); - // Debug - Tekst := IDebug[Ini.Debug]; - IniFile.WriteString('Game', 'Debug', Tekst); + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); - // Screens - Tekst := IScreens[Ini.Screens]; - IniFile.WriteString('Graphics', 'Screens', Tekst); + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); - // FullScreen - Tekst := IFullScreen[Ini.FullScreen]; - IniFile.WriteString('Graphics', 'FullScreen', Tekst); + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); - // Resolution - Tekst := IResolution[Ini.Resolution]; - IniFile.WriteString('Graphics', 'Resolution', Tekst); + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); - // Depth - Tekst := IDepth[Ini.Depth]; - IniFile.WriteString('Graphics', 'Depth', Tekst); + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); - // Resolution - Tekst := ITextureSize[Ini.TextureSize]; - IniFile.WriteString('Graphics', 'TextureSize', Tekst); + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); - // Sing Window - Tekst := ISingWindow[Ini.SingWindow]; - IniFile.WriteString('Graphics', 'SingWindow', Tekst); + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); - // Oscilloscope - Tekst := IOscilloscope[Ini.Oscilloscope]; - IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); - // Spectrum - Tekst := ISpectrum[Ini.Spectrum]; - IniFile.WriteString('Graphics', 'Spectrum', Tekst); + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - // Spectrograph - Tekst := ISpectrograph[Ini.Spectrograph]; - IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); - // Movie Size - Tekst := IMovieSize[Ini.MovieSize]; - IniFile.WriteString('Graphics', 'MovieSize', Tekst); + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); - // MicBoost - Tekst := IMicBoost[Ini.MicBoost]; - IniFile.WriteString('Sound', 'MicBoost', Tekst); + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); - // ClickAssist - Tekst := IClickAssist[Ini.ClickAssist]; - IniFile.WriteString('Sound', 'ClickAssist', Tekst); + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); - // BeatClick - Tekst := IBeatClick[Ini.BeatClick]; - IniFile.WriteString('Sound', 'BeatClick', Tekst); + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); - // Threshold - Tekst := IThreshold[Ini.Threshold]; - IniFile.WriteString('Sound', 'Threshold', Tekst); + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); - // Song Preview - Tekst := IPreviewVolume[Ini.PreviewVolume]; - IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); - Tekst := IPreviewFading[Ini.PreviewFading]; - IniFile.WriteString('Sound', 'PreviewFading', Tekst); + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); - // SavePlayback - Tekst := ISavePlayback[Ini.SavePlayback]; - IniFile.WriteString('Sound', 'SavePlayback', Tekst); + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); - // Lyrics Font - Tekst := ILyricsFont[Ini.LyricsFont]; - IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); - // Lyrics Effect - Tekst := ILyricsEffect[Ini.LyricsEffect]; - IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); - // Solmization - Tekst := ISolmization[Ini.Solmization]; - IniFile.WriteString('Lyrics', 'Solmization', Tekst); + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); - // Theme - Tekst := ITheme[Ini.Theme]; - IniFile.WriteString('Themes', 'Theme', Tekst); + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); - // Skin - Tekst := ISkin[Ini.SkinNo]; - IniFile.WriteString('Themes', 'Skin', Tekst); + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); - // Color - Tekst := IColor[Ini.Color]; - IniFile.WriteString('Themes', 'Color', Tekst); + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); - // Record - for I := 0 to High(CardList) do begin - S := IntToStr(I+1); + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); - Tekst := CardList[I].Name; - IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + // Record + for I := 0 to High(CardList) do begin + S := IntToStr(I+1); - Tekst := IntToStr(CardList[I].Input); - IniFile.WriteString('Record', 'Input' + S, Tekst); + Tekst := CardList[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); - Tekst := IntToStr(CardList[I].ChannelL); - IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + Tekst := IntToStr(CardList[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); - Tekst := IntToStr(CardList[I].ChannelR); - IniFile.WriteString('Record', 'ChannelR' + S, Tekst); - end; + Tekst := IntToStr(CardList[I].ChannelL); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); - //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + Tekst := IntToStr(CardList[I].ChannelR); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; - //Advanced Settings + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); - //LoadAnimation - Tekst := ILoadAnimation[Ini.LoadAnimation]; - IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + //Advanced Settings - //EffectSing - Tekst := IEffectSing[Ini.EffectSing]; - IniFile.WriteString('Advanced', 'EffectSing', Tekst); + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - //ScreenFade - Tekst := IScreenFade[Ini.ScreenFade]; - IniFile.WriteString('Advanced', 'ScreenFade', Tekst); + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); - //AskbeforeDel - Tekst := IAskbeforeDel[Ini.AskbeforeDel]; - IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); - //OnSongClick - Tekst := IOnSongClick[Ini.OnSongClick]; - IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Advanced', 'LineBonus', Tekst); + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); - //Party Popup - Tekst := IPartyPopup[Ini.PartyPopup]; - IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); - // Joypad - Tekst := IJoypad[Ini.Joypad]; - IniFile.WriteString('Controller', 'Joypad', Tekst); + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); IniFile.Free; end; @@ -709,8 +726,10 @@ var IniFile: TIniFile; I: integer; begin - if not FileIsReadOnly(GamePath + 'config.ini') then begin - IniFile := TIniFile.Create(GamePath + 'config.ini'); + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); //Name // Templates for Names Mod @@ -730,8 +749,10 @@ var IniFile: TIniFile; I: integer; begin - if not FileIsReadOnly(GamePath + 'config.ini') then begin - IniFile := TIniFile.Create(GamePath + 'config.ini'); + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); // Difficulty IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 59e25954..9d20d2f1 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -11,13 +11,14 @@ type FileBenchmark: TextFile; FileBenchmarkO: boolean; // opened - FileAnalyze: TextFile; - FileAnalyzeO: boolean; // opened FileError: TextFile; FileErrorO: boolean; // opened Title: String; //Application Title + //Should Log Files be written + Enabled: Boolean; + // destuctor destructor Free; @@ -26,9 +27,6 @@ type procedure BenchmarkEnd(Number: integer); procedure LogBenchmark(Text: string; Number: integer); - // analyze - procedure LogAnalyze(Text: string); - // error procedure LogError(Text: string); overload; @@ -47,7 +45,7 @@ var Log: TLog; implementation -uses UFiles, SysUtils, DateUtils, URecord, UTime, UIni, Windows; +uses UFiles, SysUtils, DateUtils, URecord, UTime, UIni, Windows, UCommandLine; destructor TLog.Free; begin @@ -78,7 +76,7 @@ var ValueText: string; begin - if (ParamStr(1) = '-benchmark') then begin + if Enabled AND (Params.Benchmark) then begin if not FileBenchmarkO then begin FileBenchmarkO := true; AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); @@ -86,6 +84,16 @@ begin Rewrite(FileBenchmark); if IOResult = 0 then FileBenchmarkO := true; {$I+} + + //If File is opened write Date to Benchmark File + If (FileBenchmarkO) then + begin + WriteLn(FileBenchmark, Title + ' Benchmark File'); + WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileBenchmark, '-------------------'); + + Flush(FileBenchmark); + end; end; if FileBenchmarkO then begin @@ -133,44 +141,34 @@ begin end; end; -procedure TLog.LogAnalyze(Text: string); -var - Seconds: integer; - Miliseconds: integer; - ValueText: string; -begin - //if Ini.Debug = 1 then begin - - if not FileAnalyzeO then begin - AssignFile(FileAnalyze, LogPath + 'Analyze.log'); - {$I-} - Rewrite(FileAnalyze); - if IOResult = 0 then FileAnalyzeO := true; - {$I+} - end; - - if FileAnalyzeO then begin - WriteLn(FileAnalyze, Text); - Flush(FileAnalyze); // try to speed up - end; - - //end; -end; - procedure TLog.LogError(Text: string); begin - if not FileErrorO then begin + if Enabled AND (not FileErrorO) then begin FileErrorO := true; AssignFile(FileError, LogPath + 'Error.log'); {$I-} Rewrite(FileError); if IOResult = 0 then FileErrorO := true; {$I+} + + //If File is opened write Date to Error File + If (FileErrorO) then + begin + WriteLn(FileError, Title + ' Error Log'); + WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileError, '-------------------'); + + Flush(FileError); + end; end; if FileErrorO then begin - WriteLn(FileError, Text); - Flush(FileError); + try + WriteLn(FileError, Text); + Flush(FileError); + except + FileErrorO := false; + end; end; end; @@ -225,3 +223,5 @@ begin end; end. + + diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 3bf7d197..b47047a5 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -95,7 +95,7 @@ function GetTimeFromBeat(Beat: integer): real; procedure ClearScores(PlayerNum: integer); implementation -uses USongs, UJoystick, math; +uses USongs, UJoystick, math, UCommandLine; procedure MainLoop; var @@ -105,7 +105,7 @@ begin While not Done do Begin // joypad - if Ini.Joypad = 1 then + if (Ini.Joypad = 1) OR (Params.Joypad) then Joy.Update; // keyboard events -- cgit v1.2.3 From a91908d71f4ea3b21f30f40a9e7dab09760ec1c2 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 8 Jul 2007 13:11:20 +0000 Subject: added another effect (sparkling stars that fall down) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@277 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 67 +++++++++++++++++++++++++++++++++-- 1 file changed, 65 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index e1cd8aff..5f0b0b4e 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -2,10 +2,11 @@ unit UGraphicClasses; interface +uses UTexture; const DelayBetweenFrames : Cardinal = 60; type - TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle); + TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); TColour3f = Record r, g, b: Real; @@ -52,6 +53,8 @@ type 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; @@ -76,7 +79,7 @@ type var GoldenRec : TEffectManager; implementation -uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, UTexture, math, dialogs; +uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, math, dialogs; //TParticle Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); @@ -173,6 +176,52 @@ begin 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; @@ -226,6 +275,20 @@ begin 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.5; +// mX:=mX/2; + end; end; end; -- cgit v1.2.3 From e8ff96a8c44e152a2cb7b71579249c15a10f4168 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 9 Jul 2007 14:00:16 +0000 Subject: Added missing UCommandLine.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@282 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommandLine.pas | 280 +++++++++++++++++++++++++++++++++++++ 1 file changed, 280 insertions(+) create mode 100644 Game/Code/Classes/UCommandLine.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas new file mode 100644 index 00000000..03229721 --- /dev/null +++ b/Game/Code/Classes/UCommandLine.pas @@ -0,0 +1,280 @@ +unit UCommandLine; + +interface + +type + //----------- + // TCMDParams - Class Reaads Infos from ParamStr and set some easy Interface Variables + //----------- + TCMDParams = class + private + sLanguage: String; + sResolution: String; + public + //Some Boolean Variables Set when Reading Infos + Debug: Boolean; + Benchmark: Boolean; + NoLog: Boolean; + FullScreen: Boolean; + Joypad: Boolean; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + Depth: Integer; + Screens: Integer; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath: String; + ConfigFile: String; + ScoreFile: String; + + //Pseudo Integer Values + Function GetLanguage: Integer; + Property Language: Integer read GetLanguage; + + Function GetResolution: Integer; + Property Resolution: Integer read GetResolution; + + //Some Procedures for Reading Infos + Constructor Create; + + Procedure ResetVariables; + Procedure ReadParamInfo; + end; + +var + Params: TCMDParams; + +implementation +uses SysUtils, UIni; + +//------------- +// Constructor - Create class, Reset Variables and Read Infos +//------------- +Constructor TCMDParams.Create; +begin + ResetVariables; + ReadParamInfo; +end; + +//------------- +// ResetVariables - Reset Class Variables +//------------- +Procedure TCMDParams.ResetVariables; +begin + Debug := False; + Benchmark := False; + NoLog := False; + FullScreen := False; + Joypad := False; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + sResolution := ''; + sLanguage := ''; + Depth := -1; + Screens := -1; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath := ''; + ConfigFile := ''; + ScoreFile := ''; +end; + +//------------- +// ReadParamInfo - Read Infos from Parameters +//------------- +Procedure TCMDParams.ReadParamInfo; +var + I: Integer; + PCount: Integer; + Command: String; +begin + PCount := ParamCount; + //Log.LogError('ParamCount: ' + Inttostr(PCount)); + + //Check all Parameters + For I := 1 to PCount do + begin + Command := Paramstr(I); + //Log.LogError('Start parsing Command: ' + Command); + //Is String Parameter ? + if (Length(Command) > 1) AND (Command[1] = '-') then + begin + //Remove - from Command + Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); + //Log.LogError('Command prepared: ' + Command); + + //Check Command + + // Boolean Triggers: + if (Command = 'debug') then + Debug := True + else if (Command = 'benchmark') then + Benchmark := True + else if (Command = 'nolog') then + NoLog := True + else if (Command = 'fullscreen') then + Fullscreen := True + else if (Command = 'joypad') then + Joypad := True + + //Integer Variables + else if (Command = 'depth') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '16') then + Depth := 0 + Else If (Command = '32') then + Depth := 1; + end; + end + + else if (Command = 'screens') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '1') then + Screens := 0 + Else If (Command = '2') then + Screens := 1; + end; + end + + //Pseudo Integer Values + else if (Command = 'language') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sLanguage := Lowercase(ParamStr(I + 1)); + end; + end + + else if (Command = 'resolution') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sResolution := Lowercase(ParamStr(I + 1)); + end; + end + + //String Values + else if (Command = 'songpath') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + SongPath := ParamStr(I + 1); + end; + end + + else if (Command = 'configfile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ConfigFile := ParamStr(I + 1); + + //is this a relative PAth -> then add Gamepath + if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then + ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; + end; + end + + else if (Command = 'scorefile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ScoreFile := ParamStr(I + 1); + end; + end; + + end; + + end; + +{ Log.LogError('Values: '); + + if Debug then + Log.LogError('Debug'); + + if Benchmark then + Log.LogError('Benchmark'); + + if NoLog then + Log.LogError('NoLog'); + + if Fullscreen then + Log.LogError('FullScreen'); + + if JoyStick then + Log.LogError('Joystick'); + + + Log.LogError('Screens: ' + Inttostr(Screens)); + Log.LogError('Depth: ' + Inttostr(Depth)); + + Log.LogError('Resolution: ' + Inttostr(Resolution)); + Log.LogError('Resolution: ' + Inttostr(Language)); + + Log.LogError('sResolution: ' + sResolution); + Log.LogError('sLanguage: ' + sLanguage); + + Log.LogError('ConfigFile: ' + ConfigFile); + Log.LogError('SongPath: ' + SongPath); + Log.LogError('ScoreFile: ' + ScoreFile); } + +end; + +//------------- +// GetLanguage - Get Language ID from saved String Information +//------------- +Function TCMDParams.GetLanguage: Integer; +var + I: integer; +begin + Result := -1; + + //Search for Language + For I := 0 to high(ILanguage) do + if (LowerCase(ILanguage[I]) = sLanguage) then + begin + Result := I; + Break; + end; +end; + +//------------- +// GetResolution - Get Resolution ID from saved String Information +//------------- +Function TCMDParams.GetResolution: Integer; +var + I: integer; +begin + Result := -1; + + //Search for Resolution + For I := 0 to high(IResolution) do + if (LowerCase(IResolution[I]) = sResolution) then + begin + Result := I; + Break; + end; +end; + +end. \ No newline at end of file -- cgit v1.2.3 From 0ea8eaa9fcf83bb7c014109eba6a8c4e25fd1a9f Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 20 Jul 2007 21:26:39 +0000 Subject: UGraphicClasses.pas: minor modification to Flare effect UMusic.pas: modified Music.Play to play from start if Loop is set (dunno if this conflicts with something else, don't hope so) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@303 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphicClasses.pas | 2 +- Game/Code/Classes/UMusic.pas | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 5f0b0b4e..032830b9 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -286,7 +286,7 @@ begin // move around X := X + mX; Y := Y + mY; - mY:=mY+1.5; + mY:=mY+1.8; // mX:=mX/2; end; end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 3fcd2a21..4e647ed3 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -407,6 +407,7 @@ procedure TMusic.Play; begin if Loaded then begin // MediaPlayer.Play; + if Loop then BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class BASS_ChannelPlay(Bass, False); // for setting position before playing end; end; -- cgit v1.2.3 From 8f170f0cad67b6bd94e04fe517ba3fe0dfe1099d Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 21 Jul 2007 00:09:19 +0000 Subject: notes can now have tiled texture (32x32 pixels) http://imageshock.eu/img/tilednotes_PoC.jpg http://imageshock.eu/img/tilednotes_PoC2.jpg git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@311 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 077f5121..df729bd4 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -255,11 +255,13 @@ begin Rec.Right := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].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(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f((Rec.Right-Rec.Left)/32, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f((Rec.Right-Rec.Left)/32, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; // prawa czesc - right part @@ -363,8 +365,8 @@ var 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); + glTexCoord2f((Rec.Right-Rec.Left)/32, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f((Rec.Right-Rec.Left)/32, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; glColor3f(1, 1, 1); -- cgit v1.2.3 From 4d300a0b6d5b074fcea0a1cf9b04f180782aa1c1 Mon Sep 17 00:00:00 2001 From: mogguh Date: Sat, 21 Jul 2007 16:30:37 +0000 Subject: Timeprogressbar in singscreen has the new tile capability (8x8 px) Fixed a minor texture bug too New kinkier dx skin parts will arrive in the svn soon too git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@312 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index df729bd4..d9582aee 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1646,20 +1646,22 @@ begin 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 + // 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); - +// glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + // glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); + glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(x,y); - glTexCoord2f(0, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); + glTexCoord2f(1, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); glTexCoord2f(1, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); - glTexCoord2f(1, 0); glVertex2f(x, y+height); + glTexCoord2f(0, 1); glVertex2f(x, y+height); glEnd; glDisable(GL_TEXTURE_2D); -- cgit v1.2.3 From 3c45a26796c089e79bce700729d019251adeeff3 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 21 Jul 2007 20:40:18 +0000 Subject: texture tiling for notes now stretches the middle part just as much as needed to seamlessly attach both ends git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@313 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index d9582aee..bf85888d 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -260,8 +260,8 @@ begin glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f((Rec.Right-Rec.Left)/32, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f((Rec.Right-Rec.Left)/32, 0); glVertex2f(Rec.Right, Rec.Top); + 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 @@ -362,11 +362,13 @@ var // glColor3f(R, G, B); // glBindTexture(GL_TEXTURE_2D, Tex_MidGray.TexNum); glBindTexture(GL_TEXTURE_2D, Tex_Mid[NrGracza+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((Rec.Right-Rec.Left)/32, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f((Rec.Right-Rec.Left)/32, 0); glVertex2f(Rec.Right, Rec.Top); + 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); -- cgit v1.2.3 From 4ddd757d3ee4fa079d8601e03dec0522940070cf Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 21 Jul 2007 20:48:07 +0000 Subject: Modified LoadTexture so that it ignores the Format parameter (for texture files, if supplied) but detects the file format by looking at the file's extension. Now any supported filetype can be used to skin USDX (not only JPG or BMP, which was hardcoded default everywhere) The remains of this former misguided policy are still in many places of the code and have to be removed over time. Also tried to remove most of the non-english comments and variable names git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@314 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 461 +++++++++++++++++++---------------------- 1 file changed, 215 insertions(+), 246 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 275f0748..43a8737e 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -14,11 +14,6 @@ interface uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; -//procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; -//function gluBuild2DMipmaps (target: GLenum; components, width, height: GLint; -// format, atype: GLenum; data: Pointer): Integer; stdcall; external glu32; -//procedure glCopyTexImage2D(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); stdcall; external opengl32; - type TTexture = record @@ -66,9 +61,9 @@ type function GetTexture(Name, Typ: string): TTexture; overload; function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Nazwa: string): TTexture; overload; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); end; @@ -77,24 +72,14 @@ var Texture: TTextureUnit; TextureDatabase: TTextureDatabase; - - // for print screens -// PrintScreenTex: GLuint; -// PrintScreenData: array[0..480-1, 0..640-1] of longword; PrintScreenData: array[0..1024*768-1] of longword; -// Tekstur: Gluint; ActTex: GLuint;//integer; -{ Tekstura: array[1..32] of TTekstura; - Mipmapping: boolean = true;} - - TexOrygW: integer; - TexOrygH: integer; + TexOrigW: integer; + TexOrigH: integer; TexNewW: integer; TexNewH: integer; -{ RLE: array[1..128*128] of byte; - RLE2: array[1..128*128] of byte;} TexFitW: integer; TexFitH: integer; // new for limit @@ -107,15 +92,13 @@ var // total 40MB at 2048*2048 // total 10MB at 1024*1024 -{ Paleta: array[0..255, 1..4] of byte; - Len: integer;} Mipmapping: Boolean; CacheMipmap: array[0..256*256*3-1] of byte; // 3KB implementation -uses ULog, DateUtils, UCovers; +uses ULog, DateUtils, UCovers, StrUtils; function TTextureUnit.GetTexture(Name, Typ: string): TTexture; begin @@ -138,7 +121,7 @@ begin TextureDatabase.Texture[T].Name := Name; TextureDatabase.Texture[T].Typ := Typ; - // inform database that not textures has been loaded into memory + // inform database that no textures have been loaded into memory TextureDatabase.Texture[T].Texture.TexNum := -1; TextureDatabase.Texture[T].TextureCache.TexNum := -1; end; @@ -163,12 +146,6 @@ begin if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin // load texture Covers.PrepareData(Name); -{ Covers.Data[0] := 0; - Covers.Data[1] := 0; - Covers.Data[2] := 0; - Covers.Data[3] := 255; - Covers.Data[4] := 255; - Covers.Data[5] := 255;} TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); end; @@ -187,7 +164,7 @@ begin Result := T; end; -function TTextureUnit.LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; TextureB: TBitmap; @@ -198,8 +175,8 @@ var TransparentColor: TColor; PixelColor: TColor; - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; Pix: integer; ColInt: real; PPix: PByteArray; @@ -213,27 +190,35 @@ begin if FromRegistry then begin try - Res := TResourceStream.Create(HInstance, Nazwa, Format); + Res := TResourceStream.Create(HInstance, Identifier, Format); except beep; Exit; end; end; - if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin + // filetype "detection" + if (not FromRegistry) and (FileExists(Identifier)) then begin + Format:=''; + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + end; +// else Format:='JPG'; +// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; + + if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin TextureB := TBitmap.Create; if Format = 'BMP' then begin if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Nazwa); + else TextureB.LoadFromFile(Identifier); end else if Format = 'JPG' then begin TextureJ := TJPEGImage.Create; if FromRegistry then TextureJ.LoadFromStream(Res) else begin - if FileExists(Nazwa) then - TextureJ.LoadFromFile(Nazwa) + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) else Exit; end; @@ -245,8 +230,8 @@ begin TexturePNG := TPNGObject.Create; if FromRegistry then TexturePNG.LoadFromStream(Res) else begin - if FileExists(Nazwa) then - TexturePNG.LoadFromFile(Nazwa) + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) else Exit; end; @@ -258,13 +243,13 @@ begin if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then begin - // i would have preferred english variables here but i use Pet because i'm lazy - for Pet := 0 to TextureB.Height - 1 do + // i would have preferred english variables here but i use Position because i'm lazy + for Position := 0 to TextureB.Height - 1 do begin - AlphaPtr := PByte(TexturePNG.AlphaScanline[Pet]); - for Pet2 := 0 to TextureB.Width - 1 do + AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); + for Position2 := 0 to TextureB.Width - 1 do begin - TextureAlpha[Pet*TextureB.Width+Pet2]:= AlphaPtr^; + TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; Inc(AlphaPtr); end; end; @@ -278,7 +263,7 @@ begin if FromRegistry then Res.Free; if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver - Log.LogError('Image ' + Nazwa + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); Result.TexNum := -1; end else begin @@ -289,46 +274,46 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); if Typ = 'Plain' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - // kopiowanie + // copy and process pixeldata TextureB.PixelFormat := pf24bit; { if (TextureB.PixelFormat = pf8bit) then begin - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD24[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD24[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD24[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD24[Position*TexNewW + Position2+1, 1] := Pix; + TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); end; end; end;} - if (TexOrygW <= Limit) and (TexOrygW <= Limit) then begin + if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin if (TextureB.PixelFormat = pf24bit) then begin - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD24[Pet*TexNewW + Pet2+1, 1] := PPix[Pet2*3+2]; - TextureD24[Pet*TexNewW + Pet2+1, 2] := PPix[Pet2*3+1]; - TextureD24[Pet*TexNewW + Pet2+1, 3] := PPix[Pet2*3]; + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; end; end; end; end else begin // limit - TexFitW := 4 * (TexOrygW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrygH; + TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrigH; if (TextureB.PixelFormat = pf24bit) then begin - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD24[Pet*TexFitW + Pet2+1, 1] := PPix[Pet2*3+2]; - TextureD24[Pet*TexFitW + Pet2+1, 2] := PPix[Pet2*3+1]; - TextureD24[Pet*TexFitW + Pet2+1, 3] := PPix[Pet2*3]; + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; end; end; end; @@ -337,25 +322,25 @@ begin TexNewW := Limit; TexNewH := Limit; - TexOrygW := Limit; - TexOrygH := Limit; + TexOrigW := Limit; + TexOrigH := Limit; end; // creating cache mipmap if CreateCacheMipmap then begin - if (TexOrygW <> TexNewW) or (TexOrygH <> TexNewH) then begin + if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin // texture only uses some of it's space. there's a need for resize to fit full size // and get best quality - TexFitW := 4 * (TexOrygW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrygW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrygH; - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD242[Pet*TexFitW + Pet2+1, 1] := PPix[(Pet2+SkipX)*3+2]; - TextureD242[Pet*TexFitW + Pet2+1, 2] := PPix[(Pet2+SkipX)*3+1]; - TextureD242[Pet*TexFitW + Pet2+1, 3] := PPix[(Pet2+SkipX)*3]; + TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage + SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image + + TexFitH := TexOrigH; + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; + TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; + TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; end; end; gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, @@ -363,7 +348,7 @@ begin end else begin // texture fits perfectly - gluScaleImage(GL_RGB, TexOrygW, TexOrygH, GL_UNSIGNED_BYTE, @TextureD24, + gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time end; end; @@ -376,31 +361,31 @@ begin end; if Typ = 'Transparent' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; - // kopiowanie - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; // ,- part of transparent png hack if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) - TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 4] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; end else begin - TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); // transparent png hack start (part 2 of 2) if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Pet*TexOrygW+Pet2]; + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; // the following calculations tweak transparency so that it really looks transparent myAlpha:=myAlpha-75; @@ -409,10 +394,10 @@ begin myAlpha:=myAlpha*myAlpha*myAlpha; myAlpha:=myAlpha*255; - TextureD32[Pet*TexNewW+Pet2+1,4]:=floor(myAlpha); + TextureD32[Position*TexNewW+Position2+1,4]:=floor(myAlpha); end else // transparent png hack end - TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + TextureD32[Position*TexNewW + Position2+1, 4] := 255; end; end; end; @@ -424,21 +409,21 @@ begin end; if Typ = 'Transparent Range' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; - // kopiowanie - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); - TextureD32[Pet*TexNewW + Pet2+1, 4] := 256 - Pix div 256; + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -450,12 +435,12 @@ begin if Typ = 'Font' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := 255; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := Pix; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); @@ -469,10 +454,10 @@ begin if Typ = 'Font Outline' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; Col := Pix; if Col < 127 then Col := 127; @@ -483,8 +468,8 @@ begin if Pix < 95 then TempA := (Pix * 256) div 96; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); @@ -498,10 +483,10 @@ begin if Typ = 'Font Outline 2' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; Col := Pix; if Col < 31 then Col := 31; @@ -510,8 +495,8 @@ begin if TempA >= 31 then TempA := 255; if Pix < 31 then TempA := Pix * (256 div 32); - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); @@ -524,24 +509,24 @@ begin end; if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s - // wymiary + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions TextureB.PixelFormat := pf24bit; - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2*3]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -549,42 +534,42 @@ begin if Typ = 'Alpha Black Colored' then begin TextureB.PixelFormat := pf24bit; - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2*3]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Col and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); end; if Typ = 'Font Gray' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -596,10 +581,10 @@ begin if Typ = 'Arrow' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; // transparency if Pix >= 127 then TempA := 255; @@ -610,10 +595,10 @@ begin if Pix >= 127 then ColInt := 2 - Pix / 128; //0.75, 0.6, 0.25 - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -626,22 +611,22 @@ begin end; if Typ = 'Note Plain' then begin - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin // Skin Patch // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Pet2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); 255: Pix := $FFFFFF; end; // 0.5.0. Original -// case PPix[Pet2*3] of +// case PPix[Position2*3] of // 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; // 192: Pix := Col; // 255: Pix := $FFFFFF; @@ -651,33 +636,33 @@ begin - TextureD24[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; - TextureD24[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); end; if Typ = 'Note Transparent' then begin - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin TempA := 255; //Skin Patch // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Pet2*3] of + case PPix[Position2*3] of 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); 255: Pix := $FFFFFF; end; // 0.5.0 Original -// case PPix[Pet2*3] of +// case PPix[Position2*3] of // 0: TempA := 0; // 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; // 192: Pix := Col; @@ -687,25 +672,16 @@ begin - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); end; - - - TextureB.Free; -// Inc(ActTex); -{ Tekst.Tekstura := ActTex; - Tekst.W := TexOrygW; - Tekst.H := TexOrygH; - Tekst.X2 := TexOrygW/TexNewW; - Tekst.Y2 := TexOrygH/TexNewH;} Result.X := 0; Result.Y := 0; Result.W := 0; @@ -714,8 +690,8 @@ begin Result.ScaleH := 1; Result.Rot := 0; Result.TexNum := ActTex; - Result.TexW := TexOrygW / TexNewW; - Result.TexH := TexOrygH / TexNewH; + Result.TexW := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; Result.Int := 1; Result.ColR := 1; @@ -730,32 +706,32 @@ begin Result.TexY2 := 1; // 0.5.0 - Result.Name := Nazwa; + Result.Name := Identifier; end; Log.BenchmarkEnd(4); if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Nazwa + '/' + Typ, 4); + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); end; // logerror end; {procedure ResizeTexture(s: pbytearray; d: pbytearray); var - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; begin - for Pet := 0 to TexNewH*4-1 do - for Pet2 := 0 to TexNewW-1 do - d[Pet*TexNewW + Pet2] := 0; - - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - d[(Pet*TexNewW + Pet2)*4] := Paleta[s[Pet*TexOrygW + Pet2], 1]; - d[(Pet*TexNewW + Pet2)*4+1] := Paleta[s[Pet*TexOrygW + Pet2], 2]; - d[(Pet*TexNewW + Pet2)*4+2] := Paleta[s[Pet*TexOrygW + Pet2], 3]; - d[(Pet*TexNewW + Pet2)*4+3] := Paleta[s[Pet*TexOrygW + Pet2], 4]; + for Position := 0 to TexNewH*4-1 do + for Position2 := 0 to TexNewW-1 do + d[Position*TexNewW + Position2] := 0; + + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; + d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; + d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; + d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; end; end; end;} @@ -770,22 +746,22 @@ begin glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); end;} -function TTextureUnit.LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; begin - Result := LoadTexture(false, Nazwa, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Nazwa, Format, Typ, Col); // default to SkinReg + Result := LoadTexture(false, Identifier, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg end; -function TTextureUnit.LoadTexture(Nazwa: string): TTexture; +function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin - Result := LoadTexture(false, pchar(Nazwa), 'JPG', 'Plain', 0); + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); end; function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; var - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; Pix: integer; ColInt: real; PPix: PByteArray; @@ -806,13 +782,6 @@ begin if Error > 0 then beep; end; - -// Inc(ActTex); -{ Tekst.Tekstura := ActTex; - Tekst.W := TexOrygW; - Tekst.H := TexOrygH; - Tekst.X2 := TexOrygW/TexNewW; - Tekst.Y2 := TexOrygH/TexNewH;} Result.X := 0; Result.Y := 0; Result.W := 0; -- cgit v1.2.3 From e82d6d67a61bc5437074e9fe20a35d2c3945e6ab Mon Sep 17 00:00:00 2001 From: mogguh Date: Sat, 21 Jul 2007 21:43:39 +0000 Subject: Fixed df typo in skins which caused a major feature not show up There was an error while uploading UDraw.pas last time, fixed now Still working on eyecandy for dx skin, some snippets are in the svn now git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@315 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index bf85888d..8945e591 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1648,21 +1648,19 @@ begin 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 + 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); -// glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); - // glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(x,y); - glTexCoord2f(1, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); - glTexCoord2f(1, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); glTexCoord2f(0, 1); glVertex2f(x, y+height); glEnd; -- cgit v1.2.3 From a5955bf26ecfe0ec20c70aff6522d1f8bd2e677d Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 22 Jul 2007 18:30:33 +0000 Subject: changed loading of transparent PNGs, should be slower now, might break with some PNG types but gives nice correct transparency for 24bit transparent PNGs git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@320 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 43a8737e..84604367 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -184,6 +184,8 @@ var Error: integer; SkipX: integer; myAlpha: Real; + myRGBABitmap: array of byte; + RGBPtr: PByte; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -240,6 +242,7 @@ begin if (Typ = 'Transparent') and (TexturePNG.TransparencyMode = ptmPartial) then begin setlength(TextureAlpha, TextureB.Width*TextureB.Height); + setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then begin @@ -247,9 +250,18 @@ begin for Position := 0 to TextureB.Height - 1 do begin AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); + RGBPtr:=PByte(TexturePNG.Scanline[Position]); for Position2 := 0 to TextureB.Width - 1 do begin TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; + MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; +// Inc(RGBPtr); Inc(AlphaPtr); end; end; @@ -379,28 +391,22 @@ begin TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; + end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; + TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; + TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; + TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; + TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - // transparent png hack start (part 2 of 2) - if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - - // the following calculations tweak transparency so that it really looks transparent - myAlpha:=myAlpha-75; - if myAlpha < 0 then myAlpha:=0; - myAlpha:=myAlpha/180; - myAlpha:=myAlpha*myAlpha*myAlpha; - myAlpha:=myAlpha*255; - - TextureD32[Position*TexNewW+Position2+1,4]:=floor(myAlpha); - end else - // transparent png hack end - TextureD32[Position*TexNewW + Position2+1, 4] := 255; + TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); + TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); + TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); + TextureD32[Position*TexNewW + Position2+1, 4] := 255; end; end; end; + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); { if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -- cgit v1.2.3 From bf62fe40a0986e0791eb462ef5adebf079e744e6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 2 Sep 2007 14:31:51 +0000 Subject: Some Cleanup in URecord Some Cleanup in UMusic Some Cleanup in ProjectFile Upgrade from Bass 2.1 to Bass 2.3 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@361 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 2 +- Game/Code/Classes/URecord.pas | 43 ++++++++++++++++++------------------------- 2 files changed, 19 insertions(+), 26 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 4e647ed3..979ba4e5 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -441,7 +441,7 @@ var begin Result := 60; - bytes := BASS_StreamGetLength(Bass); + bytes := BASS_ChannelGetLength(Bass); Result := BASS_ChannelBytes2Seconds(Bass, bytes); { if Assigned(MediaPlayer) then begin diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 2ec5439a..6ce83c0a 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -37,7 +37,8 @@ type // here can be the soundcard information - whole database from which user will select recording source Description: string; Input: array of TSoundCardInput; - InputSeleceted: integer; + InputSelected: integer; + MicInput: Integer; // bass record BassRecordStream: hStream; @@ -117,7 +118,7 @@ begin for S := 1 to 1024 do begin // 0.5.2: fix. was from 0 to 1023 // Log.LogDebug('1'); // Log.LogDebug(IntTostr(S)); - V := Abs(BufferArray[S]) / $10000; + V := Abs(BufferArray[S]) / $10000; // Log.LogDebug('2'); // Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray))); if V > MaxV then MaxV := V; @@ -279,7 +280,7 @@ var SC: integer; // soundcard SCI: integer; // soundcard input Descr: string; - InputName: string; + InputName: PChar; Flags: integer; No: integer; function isDuplicate(Desc: String): Boolean; @@ -298,7 +299,6 @@ var end; end; -// mic: array[0..15] of integer; begin // checks for recording devices and puts them into array; SetLength(SoundCard, 0); @@ -320,45 +320,37 @@ begin end; SetLength(SoundCard, SC+1); -// Log.LogError('Device #' + IntToStr(SC+1) + ': ' + Descr); + SoundCard[SC].Description := Descr; - // check for recording inputs -// mic[device] := -1; // default to no change + //Get Recording Inputs SCI := 0; BASS_RecordInit(SC); - Flags := BASS_RecordGetInput(SCI); + InputName := BASS_RecordGetInputName(SCI); -// Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName); SetLength(SoundCard[SC].Input, 1); SoundCard[SC].Input[SCI].Name := InputName; // process each input - while (Flags <> -1) do begin - if SCI >= 1 then begin + while (InputName <> nil) do begin + Flags := BASS_RecordGetInput(SCI); + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then begin + SetLength(SoundCard[SC].Input, SCI+1); - InputName := BASS_RecordGetInputName(SCI); + SoundCard[SC].Input[SCI].Name := InputName; -// Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName); end; -{ if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end;} + //Set Mic Index + if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then + SoundCard[SC].MicInput := SCI; + Inc(SCI); - Flags := BASS_RecordGetInput(SCI); + InputName := BASS_RecordGetInputName(SCI); end; -{ if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device];} - BASS_RecordFree; @@ -369,3 +361,4 @@ end; end. + -- cgit v1.2.3 From 3df211329573da9450b2388875ec952dcaa98eea Mon Sep 17 00:00:00 2001 From: mogguh Date: Sun, 2 Sep 2007 18:53:35 +0000 Subject: VFX: Some pre work for an upcoming (yet unfinished) feature git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@362 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 65 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 63 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 84604367..161b5512 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage, GraphUtil, dialogs; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -66,6 +66,7 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); + procedure Colorize(var R,G,B : Byte; Color: Cardinal); // Real colorize instead of: "150 grey is now blue, k?" end; var @@ -239,7 +240,7 @@ begin end; TextureB.Assign(TexturePNG); // transparent png hack start (part 1 of 2) - if (Typ = 'Transparent') and (TexturePNG.TransparencyMode = ptmPartial) then + if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then begin setlength(TextureAlpha, TextureB.Width*TextureB.Height); setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); @@ -414,6 +415,49 @@ begin end;} end; +// The new awesomeness of colorized pngs starts here +// We're the first who had this feature, so give credit when you copy+paste :P + if Typ = 'Colorized' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then begin + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; + TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; // R + TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; // G + TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; // B + TextureD32[Position*TexNewW+Position2+1,4] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; // Alpha + end else begin + TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); + TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); + TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); + TextureD32[Position*TexNewW + Position2+1, 4] := 255; + end; + end; + end; + + //now the colorize stuff + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], $fe198e); //pinkie :P + end; + end; + + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +// eoa COLORIZE + if Typ = 'Transparent Range' then begin // dimensions TexOrigW := TextureB.Width; @@ -759,6 +803,23 @@ begin end; + +// Funkyness of colorizing is done in this small box, remember to give credits when you copy from us +Procedure TTextureUnit.Colorize(var R,G,B : Byte; Color : Cardinal); +var + TexHue, TexLum, TexSat, ClrHue, ClrLum, ClrSat : Word; + ColorizedColors: Cardinal; +begin //red //green //blue + Color:=((Color and $ff) shl 16) or (Color and $ff00) or ((Color and $ff0000) shr 16); + ColorRGBToHLS(Color, ClrHue, ClrLum, ClrSat); + ColorRGBToHLS((((b shl 8) or g) shl 8 or r),TexHue, TexLum, TexSat); + ColorizedColors := ColorHLSToRGB(ClrHue, TexLum, TexSat); + R := ColorizedColors and $FF; + G := (ColorizedColors and $FF00) shr 8; + B := (ColorizedColors and $FF0000) shr 16; +end; +//eoa COLORIZE + function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -- cgit v1.2.3 From 69c42b2bde3146a61d4b1e8e1cbedfd7163b1c60 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 2 Sep 2007 21:06:08 +0000 Subject: finished stuff for colorized transparent textures with statics (credits to mog, who started it) still to do: same thing with buttons and maybe everything else ;) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@363 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 161b5512..3314f494 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -38,6 +38,10 @@ type TexY2: real; Alpha: real; Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + // colorize hack + Colorized: Boolean; +// Colors: array of Cardinal; +// Texnums: array of Integer; end; TTextureEntry = record @@ -448,7 +452,7 @@ begin //now the colorize stuff for Position := 0 to TexOrigH-1 do begin for Position2 := 0 to TexOrigW-1 do begin - colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], $fe198e); //pinkie :P + colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], Col); //pinkie :P end; end; -- cgit v1.2.3 From d5ebad3a661194459da1b134978ed353e46c9b72 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 2 Sep 2007 23:45:33 +0000 Subject: now buttons can also have transparent colorized textures POC-Pic: http://imageshock.eu/img/colorizedbuttons-ao81.jpg git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@365 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 4 ---- 1 file changed, 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 3314f494..ab21d44c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -38,10 +38,6 @@ type TexY2: real; Alpha: real; Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - // colorize hack - Colorized: Boolean; -// Colors: array of Cardinal; -// Texnums: array of Integer; end; TTextureEntry = record -- cgit v1.2.3 From 247cbdca4eb8af228fa1753f1185e85077b5befa Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 7 Sep 2007 21:09:02 +0000 Subject: UScreenSing.pas, UScreenSingModi.pas: removed Uffmpeg and USmpeg, added UVideo UGraphic.pas: prepared for possible loading animation UGraphicClasses.pas, ULCD.pas, ULight.pas, UMain.pas, USkins.pas, UDisplay.pas, UMenuButton.pas, UMenuSelect.pas, UMenuSelectSlide.pas, UMenuStatic.pas, UScreenCredits.pas, UScreenEditSub.pas, UScreenOpen.pas, UScreenPopup.pas: some fixes to get rid of some compiler infos/warnings git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@374 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 60 +++++- Game/Code/Classes/UGraphicClasses.pas | 2 +- Game/Code/Classes/ULCD.pas | 10 +- Game/Code/Classes/ULight.pas | 4 +- Game/Code/Classes/UMain.pas | 1 + Game/Code/Classes/USkins.pas | 6 +- Game/Code/Classes/UVideo.pas | 378 ++++++++++++++++++++++++++++++++++ 7 files changed, 449 insertions(+), 12 deletions(-) create mode 100644 Game/Code/Classes/UVideo.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index cf1a0c5a..068ed715 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -23,6 +23,9 @@ type var Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + RenderW: integer; RenderH: integer; ScreenW: integer; @@ -174,8 +177,11 @@ procedure SwapBuffers; procedure LoadTextures; procedure InitializeScreen; +procedure LoadLoadingScreen; procedure LoadScreens; +function LoadingThreadFunction: integer; + implementation uses UMain, UIni, UDisplay, UCommandLine, Graphics, Classes, Windows; @@ -240,6 +246,7 @@ var Res: TResourceStream; ISurface: PSDL_Surface; Pixel: PByteArray; + I: Integer; begin Log.LogStatus('LoadOpenGL', 'Initialize3D'); Log.BenchmarkStart(2); @@ -302,7 +309,42 @@ begin Log.LogStatus('Loading Screens', 'Initialize3D'); Log.BenchmarkStart(3); + LoadLoadingScreen; + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // das hier würde dann im ladethread ausgeführt LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + + + //wait for loading thread to finish + // funktioniert so auch noch nicht + //SDL_WaitThread(LoadingThread, I); +// SDL_DestroyMutex(Mutex); + Display.ActualScreen^.FadeTo(@ScreenMain); Log.BenchmarkEnd(2); @@ -397,7 +439,7 @@ begin ScreenH := H; end; -procedure LoadScreens; +procedure LoadLoadingScreen; begin ScreenLoading := TScreenLoading.Create; ScreenLoading.onShow; @@ -405,7 +447,17 @@ begin ScreenLoading.Draw; Display.Draw; SwapBuffers; +end; +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); { ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} @@ -480,4 +532,10 @@ begin end; +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + end. diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 032830b9..83d192d6 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -29,7 +29,7 @@ type SurviveSentenceChange : Boolean; Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); - Destructor Destroy(); + Destructor Destroy(); override; procedure Draw; procedure LiveOn; end; diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas index a127c689..a3cdac73 100644 --- a/Game/Code/Classes/ULCD.pas +++ b/Game/Code/Classes/ULCD.pas @@ -106,9 +106,9 @@ begin end; procedure TLCD.Enable; -var +{var A: byte; - B: byte; + B: byte;} begin Enabled := true; if not HalfInterface then @@ -191,7 +191,7 @@ end; procedure TLCD.AddTextBR(S: string); var Word: string; - W: integer; +// W: integer; P: integer; L: integer; begin @@ -227,9 +227,9 @@ begin end; procedure TLCD.MoveCursorBR(Pos: integer); -var +{var I: integer; - L: integer; + L: integer;} begin if Enabled then begin Pos := Pos - (StartPos-1); diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 967d2ea1..1fc4aba8 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -89,12 +89,12 @@ end; procedure TLight.Refresh; var Time: real; - TimeSkip: real; +// TimeSkip: real; L: integer; begin if Enabled then begin Time := GetTime; - TimeSkip := Time - LastTime; +// TimeSkip := Time - LastTime; for L := 0 to 7 do begin if Light[L] = true then begin if LightTime[L] > Time then begin diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index b47047a5..3a1c9dd4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -545,6 +545,7 @@ begin // check if we can add new note Mozna := false; + SDet:=SMin; for S := SMin to SMax do for Pet := 0 to Czesci[0].Czesc[S].HighNut do if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 67b0ae93..3bcd9357 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -48,8 +48,8 @@ end; procedure TSkin.LoadList; var SR: TSearchRec; - SR2: TSearchRec; - SLen: integer; +// SR2: TSearchRec; +// SLen: integer; begin if FindFirst('Skins\*', faDirectory, SR) = 0 then begin repeat @@ -63,7 +63,7 @@ end; procedure TSkin.ParseDir(Dir: string); var SR: TSearchRec; - SLen: integer; +// SLen: integer; begin if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin repeat diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas new file mode 100644 index 00000000..8e2fc446 --- /dev/null +++ b/Game/Code/Classes/UVideo.pas @@ -0,0 +1,378 @@ +{############################################################################ +# FFmpeg support for UltraStar deluxe # +# # +# Created by b1indy # +# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # +#############################################################################} + +//{$define DebugDisplay} // uncomment if u want to see the debug stuff +{$define DebugFrames} +{$define Info} + + +unit UVideo; + +interface +uses SDL, UGraphicClasses, textgl, avcodec, avformat, avutil, math, OpenGL12, SysUtils, UIni, dialogs; + +procedure Init; +procedure FFmpegOpenFile(FileName: pAnsiChar); +procedure FFmpegClose; +procedure FFmpegGetFrame(Time: Extended); +procedure FFmpegDrawGL(Screen: integer); +procedure FFmpegTogglePause; +procedure FFmpegSkip(Time: Single); + +var + VideoOpened, VideoPaused: Boolean; + VideoFormatContext: PAVFormatContext; + VideoStreamIndex: Integer; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + myBuffer: pByte; + VideoTex: glUint; + TexX, TexY, dataX, dataY: Cardinal; + TexData: array of Byte; + ScaledVideoWidth, ScaledVideoHeight: Real; + VideoAspect: Real; + VideoTextureU, VideoTextureV: Real; + VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; + VideoSkipTime: Single; + +implementation + +procedure Init; +begin + av_register_all; + VideoOpened:=False; + VideoPaused:=False; + glGenTextures(1, PglUint(@VideoTex)); + SetLength(TexData,0); +end; + +procedure FFmpegOpenFile(FileName: pAnsiChar); +var errnum, i, x,y: Integer; +begin + VideoOpened:=False; + VideoPaused:=False; + VideoTimeBase:=0; + VideoTime:=0; + LastFrameTime:=0; + TimeDifference:=0; + errnum:=av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); + if(errnum <> 0) + then begin + case errnum of + AVERROR_UNKNOWN: showmessage('failed to open file '+Filename+#13#10+'AVERROR_UNKNOWN'); + AVERROR_IO: showmessage('failed to open file '+Filename+#13#10+'AVERROR_IO'); + AVERROR_NUMEXPECTED: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NUMEXPECTED'); + AVERROR_INVALIDDATA: showmessage('failed to open file '+Filename+#13#10+'AVERROR_INVALIDDATA'); + AVERROR_NOMEM: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOMEM'); + AVERROR_NOFMT: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOFMT'); + AVERROR_NOTSUPP: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOTSUPP'); + else showmessage('failed to open file '+Filename+#13#10+'Error number: '+inttostr(Errnum)); + end; + Exit; + end + else begin + VideoStreamIndex:=-1; + if(av_find_stream_info(VideoFormatContext)>=0) then + begin + for i:=0 to VideoFormatContext^.nb_streams-1 do + if(VideoFormatContext^.streams[i]^.codec^.codec_type=CODEC_TYPE_VIDEO) then begin + VideoStreamIndex:=i; + end else + end; + if(VideoStreamIndex >= 0) then + begin + VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; + VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); + end else begin + showmessage('found no video stream'); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(VideoCodec<>Nil) then + begin + errnum:=avcodec_open(VideoCodecContext, VideoCodec); + end else begin + showmessage('no matching codec found'); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(errnum >=0) then + begin +{$ifdef DebugDisplay} + showmessage('Found a matching Codec:'+#13#10#13#10+ + 'Width='+inttostr(VideoCodecContext^.width)+ + ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + 'Aspect: '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + '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; + end; + myBuffer:=Nil; + if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then + begin + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, + VideoCodecContext^.height)); + end; + if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, + VideoCodecContext^.width, VideoCodecContext^.height) + else begin + showmessage('failed to allocate video buffer'); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if errnum >=0 then + begin + VideoOpened:=True; + + TexX := VideoCodecContext^.width; + TexY := VideoCodecContext^.height; + dataX := Round(Power(2, Ceil(Log2(TexX)))); + dataY := Round(Power(2, Ceil(Log2(TexY)))); + SetLength(TexData,dataX*dataY*3); + // calculate some information for video display + VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; + if (VideoAspect = 0) then + VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height + else + VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; + if VideoAspect >= 4/3 then + begin + ScaledVideoWidth:=800.0; + ScaledVideoHeight:=800.0/VideoAspect; + end else + begin + ScaledVideoHeight:=600.0; + ScaledVideoWidth:=600.0*VideoAspect; + end; + VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; + // hack to get reasonable timebase for divx +{$ifdef DebugDisplay} + showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); +{$endif} + if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps + begin + VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; + while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; + VideoTimeBase:=1/VideoTimeBase; + end; +{$ifdef DebugDisplay} + showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); + if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then + showmessage('you are trying to play a rather large video'+#13#10+ + 'be prepared to experience some timing problems'); +{$endif} + end; + end; +end; + +procedure FFmpegClose; +begin + if VideoOpened then begin + av_free(myBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + SetLength(TexData,0); + VideoOpened:=False; + end; +end; + +procedure FFmpegTogglePause; +begin + if VideoPaused then VideoPaused:=False + else VideoPaused:=True; +end; + +procedure FFmpegSkip(Time: Single); +begin + VideoSkiptime:=Time; + if VideoSkipTime > 0 then begin + av_seek_frame(VideoFormatContext,-1,Floor((VideoSkipTime)*1500000),0); + VideoTime:=VideoSkipTime; + end; +end; + +procedure FFmpegGetFrame(Time: Extended); +var + FrameFinished: Integer; + AVPacket: TAVPacket; + errnum, x, y: Integer; + FrameDataPtr: PByteArray; + linesize: integer; + myTime: Extended; + DropFrame: Boolean; + droppedFrames: Integer; +const + FRAMEDROPCOUNT=3; +begin + if not VideoOpened then Exit; + if VideoPaused then Exit; + myTime:=Time+VideoSkipTime; + TimeDifference:=myTime-VideoTime; + DropFrame:=False; +{ showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +} + 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} +{ showmessage('not getting new frame'+#13#10+ + 'Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +} + Exit;// we don't need a new frame now + end; + VideoTime:=VideoTime+VideoTimeBase; + TimeDifference:=myTime-VideoTime; + if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then begin // skip frames +{$ifdef DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); +{$endif} +// showmessage('skipping frames'+#13#10+ +// 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ +// 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ +// 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); +// av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time*VideoTimeBase),0); +{ av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); + VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} + VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; + DropFrame:=True; + end; + + av_init_packet(@AVPacket); + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + begin + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, + AVPacket.data, AVPacket.size); + // release internal packet structure created by av_read_frame + av_free_packet(PAVPacket(@AVPacket)); + end; + if DropFrame then + for droppedFrames:=1 to FRAMEDROPCOUNT do begin + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + begin + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, + AVPacket.data, AVPacket.size); + // release internal packet structure created by av_read_frame + av_free_packet(PAVPacket(@AVPacket)); + end; + end; + + // if we did not get an new frame, there's nothing more to do + if Framefinished=0 then begin + GoldenRec.Spawn(220,15,1,16,0,-1,ColoredStar,$0000ff); + Exit; + end; + // otherwise we convert the pixeldata from YUV to RGB + errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); +//errnum:=1; + if errnum >=0 then begin + // copy RGB pixeldata to our TextureBuffer + // (line by line) + FrameDataPtr:=AVFrameRGB^.data[0]; + linesize:=AVFrameRGB^.linesize[0]; + for y:=0 to TexY-1 do begin + System.Move(FrameDataPtr[y*linesize],TexData[3*y*dataX],linesize); + end; + + // generate opengl texture out of whatever we got + glBindTexture(GL_TEXTURE_2D, VideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, TexData); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +{$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); +{$endif} + + end; +end; + +procedure FFmpegDrawGL(Screen: integer); +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 VideoOpened then Exit; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, VideoTex); + glbegin(gl_quads); + glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{$ifdef Info} + if VideoSkipTime+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; + +end. -- cgit v1.2.3 From 69def54f79cace3a1a90ae71f03910986ff74da7 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 8 Sep 2007 15:03:05 +0000 Subject: re-did the colorize stuff, now no need for GraphUtils git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@378 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 150 ++++++++++++++++++++++++++++++----------- 1 file changed, 112 insertions(+), 38 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index ab21d44c..dc1f9fc2 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage, GraphUtil, dialogs; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -66,10 +66,10 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); - procedure Colorize(var R,G,B : Byte; Color: Cardinal); // Real colorize instead of: "150 grey is now blue, k?" end; var + lasthue: double; Texture: TTextureUnit; TextureDatabase: TTextureDatabase; @@ -165,6 +165,106 @@ begin Result := T; end; +// expects: src, dst: pointers to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0]:=src[0]/255; clr[1]:=src[1]/255; clr[2]:=src[2]/255; + //calculate luminance and saturation from rgb + hls[1]:=maxvalue(clr); //l:=... + delta:=hls[1]-minvalue(clr); + if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=src[3]; + end; +end; + +// expects: src: $rrggbb +// dst: pointer to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0]:=((src shr 16) and $ff)/255; + clr[1]:=((src shr 8) and $ff)/255; + clr[2]:=(src and $ff)/255; + //calculate luminance and saturation from rgb + hls[1]:=maxvalue(clr); //l:=... + delta:=hls[1]-minvalue(clr); + if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=255; + end; +end; +//returns hue within range [0.0-6.0) +function col2h(Color:Cardinal):double; +var + clr,hls: array[0..2] of double; + delta: double; +begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; +end; + + function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; @@ -187,6 +287,7 @@ var myAlpha: Real; myRGBABitmap: array of byte; RGBPtr: PByte; + myHue: Double; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -426,29 +527,19 @@ begin TextureB.Width := TexNewW; TextureB.Height := TexNewH; + myHue:=col2h(Col); // copy and process pixeldata for Position := 0 to TexOrigH-1 do begin for Position2 := 0 to TexOrigW-1 do begin Pix := TextureB.Canvas.Pixels[Position2, Position]; - if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; // R - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; // G - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; // B - TextureD32[Position*TexNewW+Position2+1,4] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; // Alpha - end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); - TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); - TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); - TextureD32[Position*TexNewW + Position2+1, 4] := 255; - end; - end; - end; - - //now the colorize stuff - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], Col); //pinkie :P + if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then + ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue) + else + ColorizeCopy(Pix, + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue); end; end; @@ -803,23 +894,6 @@ begin end; - -// Funkyness of colorizing is done in this small box, remember to give credits when you copy from us -Procedure TTextureUnit.Colorize(var R,G,B : Byte; Color : Cardinal); -var - TexHue, TexLum, TexSat, ClrHue, ClrLum, ClrSat : Word; - ColorizedColors: Cardinal; -begin //red //green //blue - Color:=((Color and $ff) shl 16) or (Color and $ff00) or ((Color and $ff0000) shr 16); - ColorRGBToHLS(Color, ClrHue, ClrLum, ClrSat); - ColorRGBToHLS((((b shl 8) or g) shl 8 or r),TexHue, TexLum, TexSat); - ColorizedColors := ColorHLSToRGB(ClrHue, TexLum, TexSat); - R := ColorizedColors and $FF; - G := (ColorizedColors and $FF00) shr 8; - B := (ColorizedColors and $FF0000) shr 16; -end; -//eoa COLORIZE - function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -- cgit v1.2.3 From 16e0d37948cc1137d0c79f48f9b5e12e5bf77686 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 8 Sep 2007 15:33:52 +0000 Subject: did some cleanup and minor modifications UDisplay.pas: tried to make the screenfade-effect transparent (doesn't work for now) UMenu.pas: removed some unnecessary code from DrawBG UGraphic.pas: fixed display of loading screen (after it broke with the modifications in UMenu.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@379 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 068ed715..a79a16a2 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -358,7 +358,7 @@ begin SDL_GL_SwapBuffers; glMatrixMode(GL_PROJECTION); glLoadIdentity; - glOrtho(0, 800, 600, 0, -1, 100); + glOrtho(0, RenderW, RenderH, 0, -1, 100); glMatrixMode(GL_MODELVIEW); end; @@ -444,6 +444,7 @@ begin ScreenLoading := TScreenLoading.Create; ScreenLoading.onShow; Display.ActualScreen := @ScreenLoading; + swapbuffers; ScreenLoading.Draw; Display.Draw; SwapBuffers; -- cgit v1.2.3 From 13666b8a713f7f46d1db186ba147aa91984ddb0f Mon Sep 17 00:00:00 2001 From: mogguh Date: Mon, 10 Sep 2007 13:06:56 +0000 Subject: Overall look: ScoreBGs and playerboxes (p1, p2,..) are now drawn as colorized pngs. Notes are drawn with 3 textures instead of 2: bg_glow, notebg (unsung) and note hit (sung) - these are colorized pngs - textures will come in the following commit. Known Bugs: - ScoreBGs are not yet drawn in playercolor (only affects player count > 3) - Phrasen bonus pop up, indexes are not yet filled with usable data, therefore textures are not yet loaded correctly - Linebonus not yet done git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@382 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 612 +++++++++++++++++------------------------ Game/Code/Classes/UGraphic.pas | 47 ++-- Game/Code/Classes/UMain.pas | 2 +- Game/Code/Classes/UThemes.pas | 301 ++++++-------------- 4 files changed, 365 insertions(+), 597 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 8945e591..8cfa8d7e 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,7 +1,7 @@ unit UDraw; interface -uses UThemes, ModiSDK, UGraphicClasses; +uses UThemes, ModiSDK, UGraphicClasses, dialogs; procedure SingDraw; procedure SingModiDraw (PlayerInfo: TPlayerInfo); @@ -13,14 +13,9 @@ procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: intege procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); -// TimeBar mod +// TimeBar procedure SingDrawTimeBar(); -// eoa TimeBar mod -{ for no use since we have UGraphicClasses -procedure SingDrawStar(X, Y, A: real); -procedure SingGoldenStar(X, Y, A: real); -} // The Singbar procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); @@ -52,15 +47,9 @@ var Starfr: integer; StarfrG: integer; - - - //SingBar Mod + //SingBar TickOld: cardinal; TickOld2:cardinal; - //end Singbar Mod - - - const Przedz = 32; @@ -208,8 +197,20 @@ var TempR: real; R,G,B: real; + PlayerNumber: Integer; + GoldenStarPos : real; begin +// We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero +// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 + NrCzesci := 0; + +// exploit done + glColor3f(1, 1, 1); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); @@ -225,19 +226,19 @@ begin // If Golden note Effect of then Change not Color begin case Wartosc of - 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 0.3, 0.85); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); + 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + 2: 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, 0.85); - + 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 == ende, schluss // lewa czesc - left part Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Ton-BaseNote)*Space/2 - NotesH; Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); + 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); @@ -249,12 +250,11 @@ begin GoldenStarPos := Rec.Left; //done - // srodkowa czesc - middle part Rec.Left := Rec.Right; - Rec.Right := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + Rec.Right := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge - glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); + 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); @@ -268,7 +268,7 @@ begin Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; - glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); + 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); @@ -313,134 +313,100 @@ var // 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].IlNut > 0 then begin - TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); - for N := 0 to Player[NrGracza].HighNut do begin - with Player[NrGracza].Nuta[N] do begin - // lewa czesc - Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - - - // Half size Notes Patch - if Hit then begin - NotesH2 := NotesH - end else begin - NotesH2 := int(NotesH * 0.65); - end; //if - - - - // if True then - Rec.Top := Y - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; - - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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 := Rec.Right; - Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; - // (nowe) - if (Start+Dlugosc-1 = Czas.AktBeatD) then - Rec.Right := Rec.Right - (1-Frac(Czas.MidBeatD)) * TempR; - - if Rec.Right <= Rec.Left then Rec.Right := Rec.Left; - - -// glColor3f(R, G, B); -// glBindTexture(GL_TEXTURE_2D, Tex_MidGray.TexNum); - glBindTexture(GL_TEXTURE_2D, Tex_Mid[NrGracza+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); - - // prawa czesc - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_Right[NrGracza+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; - - - //Rec.Right := X + (Start+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; - //if (Start+Dlugosc-1 = Czas.AktBeatD) then - if Perfect and (Ini.EffectSing=1) then begin -// A := sqrt((1+sin(Music.Position * 3))/2); - A := 1 - 2*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); - if not (Start+Dlugosc-1 = Czas.AktBeatD) then - - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - { SingDrawStar(Rec.Left+2, Rec.Top+4, A);} - end; - - // detekt -{ Rec.Left := Round((Detekt-Czesci.Czesc[Czesci.Akt].Start) * TempR) + 130; - glColor3f(1, 0.2, 0.2); - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - glBegin(GL_QUADS); - glVertex(Rec.Left, Rec.Top-5); - glVertex(Rec.Left, Rec.Bottom+5); - glVertex(Rec.Left+1, Rec.Bottom+5); - glVertex(Rec.Left+1, Rec.Top-5); - glEnd; - glColor3f(1, 1, 1); - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D);} - - // detekt + FFT length -{ Rec.Right := (Detekt-Czesci.Czesc[Czesci.Akt].Start) * TempR + 130; - // TempR = dlugosc 1 kostki - // 60 * 4 / BPM = czas w sekundach na 1 kostke, np. 0,4s - // 4096 / 44100 = czas jednego sampla FFT, np. 0,1s - // ile to ma kostek? np. 0.25 - // (4096 / 44100) / (60 * 4 / BPM), np. 0,1s / 0,4s = 0.25 - // * TempR = dlugosc sampla FFT - Rec.Left := Rec.Right - (Sound.n / 44100) / (60 * 4 / Muzyka.BPM) * TempR; - - glColor3f(1, 0.2, 0.2); - glVertex(Rec.Left, Rec.Top-4); - glVertex(Rec.Left, Rec.Bottom+4); - glVertex(Rec.Right, Rec.Bottom+4); - glVertex(Rec.Right, Rec.Top-4);} - - end; // with - end; // for + if Player[NrGracza].IlNut > 0 then + begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do + begin + with Player[NrGracza].Nuta[N] do + begin + // Left part of note + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; // with + end; // for // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ // passing on NrGracza... hope this is really something like the player-number, not only // some kind of weird index into a colour-table - if (Ini.EffectSing=1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); + if (Ini.EffectSing=1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); end; // if end; @@ -523,64 +489,6 @@ begin end; end; -{not used anymore tough we have UGraphicClasses -procedure SingDrawStar(X, Y, A: real); -var - TempR: real; - W, H: real; - Starframe: real; - begin - W := 32; - H := 32; - -// Golden Star Patch -// case Z of -// 1: glColor4f(1, 1, 1, A); -// 2: glColor4f(1, 1, 0.3, A); -// end; // case - - glColor4f(1, 1, 1, A); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); - - Starframe := 15 - ((GetTickCount div 33) mod 16); - - glBegin(GL_QUADS); - glTexCoord2f((1/16) * Starframe, 0); glVertex2f(X-W, Y-H); - glTexCoord2f((1/16) * Starframe + (1/16), 0); glVertex2f(X-W, Y+H); - glTexCoord2f((1/16) * Starframe + (1/16), 1); glVertex2f(X+W, Y+H); - glTexCoord2f((1/16) * Starframe, 1); glVertex2f(X+W, Y-H); - glEnd; -end; -} - -{not used anymore tough we have UGraphicClasses -procedure SingGoldenStar(X, Y, A: real); -var - TempR: real; - W, H: real; - StarfrG2: real; - begin - W := 16; - H := 16; - glColor4f(1, 1, 0.3, A); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Note_Star.TexNum); - StarfrG2 := 15 - ((GetTickCount div 67) mod 16); - glBegin(GL_QUADS); - //x1 - glTexCoord2f((1/16) * StarfrG2, 0); glVertex2f(X-W, Y-H); - glTexCoord2f((1/16) * StarfrG2 + (1/16), 0); glVertex2f(X-W, Y+H); - glTexCoord2f((1/16) * StarfrG2 + (1/16), 1); glVertex2f(X+W, Y+H); - glTexCoord2f((1/16) * StarfrG2, 1); glVertex2f(X+W, Y-H); - glEnd; -end; -} - procedure SingDraw; var Pet: integer; @@ -598,16 +506,12 @@ var LyricTemp: string; PetCz: integer; - - //SingBar Mod A: Integer; E: Integer; I: Integer; //end Singbar Mod - - begin // positions if Ini.SingWindow = 0 then begin @@ -739,51 +643,40 @@ begin else if I < 0 then Dec(Player[E].ScorePercent); end; //for end; //if + if PlayersPlay = 1 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; + end; + if PlayersPlay = 2 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; + end; + if PlayersPlay = 3 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; + if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if ScreenAct = 2 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); end; end; + if PlayersPlay = 6 then begin if ScreenAct = 1 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; if ScreenAct = 2 then begin - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); @@ -798,53 +691,58 @@ begin if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin Tickold2 := A; for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; if Player[E].LineBonus_Alpha <= 0 then begin Player[E].LineBonus_Age := 0; Player[E].LineBonus_Visible := False end else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - end; - end; - end; //if + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - if PlayersPlay = 1 then begin + end; // shift position of the pop up (if not dead) + end; // loop - for all players + end; // if - linebonus + + + if PlayersPlay = 1 then begin SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - else if PlayersPlay = 2 then begin + end + + else if PlayersPlay = 2 then begin SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end + else if PlayersPlay = 3 then begin SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end + else if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); end; if ScreenAct = 2 then begin - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); end; end; + if PlayersPlay = 6 then begin if ScreenAct = 1 then begin SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); @@ -860,9 +758,7 @@ begin end; //PhrasenBonus - Line Bonus Mod End - - // rysuje paski -// Log.LogStatus('Original notes', 'SingDraw'); +// Set the note heights according to the difficulty level case Ini.Difficulty of 0: begin @@ -881,10 +777,11 @@ begin end; end; +// Draw the Notes if PlayersPlay = 1 then begin - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes end; if (PlayersPlay = 2) then begin @@ -892,7 +789,7 @@ begin SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); @@ -907,8 +804,8 @@ begin SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); @@ -925,8 +822,14 @@ begin SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); end; - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; if ScreenAct = 1 then begin SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); @@ -953,9 +856,16 @@ begin SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); end; - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; if ScreenAct = 1 then begin SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); @@ -968,11 +878,11 @@ begin SingDrawPlayerCzesc(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 Pet: integer; @@ -990,16 +900,12 @@ var LyricTemp: string; PetCz: integer; - - //SingBar Mod A: Integer; E: Integer; I: Integer; //end Singbar Mod - - begin // positions if Ini.SingWindow = 0 then begin @@ -1007,22 +913,17 @@ begin end else begin NR.Left := 20; end; - NR.Right := 780; + 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; + NR.WMid := NR.Width / 2; + NR.Mid := NR.Left + NR.WMid; // time bar -// Log.LogStatus('Time Bar', 'SingDraw'); SingDrawTimeBar(); if DLLMan.Selected.ShowNotes then begin - // rysuje paski pod nutami 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 @@ -1037,7 +938,7 @@ begin end; end; - // rysuje tekst - new Lyric engine + // Lyric engine ScreenSingModi.LyricMain.Draw; ScreenSingModi.LyricSub.Draw; @@ -1046,40 +947,30 @@ begin BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; if BarFrom > 40 then BarFrom := 40; if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * - // (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].LyricWidth / 2 * FS - 50); - (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; -{ // 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); + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 + // 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 @@ -1138,80 +1029,69 @@ begin end //SingBar Mod - // was fürn sinn hattn der quark hier? + // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin A := GetTickCount div 33; if A <> Tickold then begin Tickold := A; for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); end; //for end; //if + if PlayersPlay = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; + end; + if PlayersPlay = 2 then begin if PlayerInfo.Playerinfo[0].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; + end; + if PlayersPlay = 3 then begin if PlayerInfo.Playerinfo[0].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); if PlayerInfo.Playerinfo[2].Enabled then - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; + if PlayersPlay = 4 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[2].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); if PlayerInfo.Playerinfo[3].Enabled then - //SingDrawSingbar(620 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); end; end; + if PlayersPlay = 6 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[0].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); if PlayerInfo.Playerinfo[1].Enabled then - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[1].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); if PlayerInfo.Playerinfo[2].Enabled then - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[2].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); end; if ScreenAct = 2 then begin if PlayerInfo.Playerinfo[3].Enabled then - //SingDrawSingbar( 75 + 10*ScreenX, 95, 100, 8, Player[3].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); if PlayerInfo.Playerinfo[4].Enabled then - //SingDrawSingbar(370 + 10*ScreenX, 95, 100, 8, Player[4].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); if PlayerInfo.Playerinfo[5].Enabled then - //SingDrawSingbar(670 + 10*ScreenX, 95, 100, 8, Player[5].ScorePercent); SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); end; end; @@ -1227,43 +1107,42 @@ begin //Change Alpha Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - if Player[E].LineBonus_Alpha <= 0 then begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False end else - begin - inc(Player[E].LineBonus_Age, 1); - - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; - end; - end; //if - - if PlayersPlay = 1 then begin + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + + end; // pop up still visible, has not reached it's position - move it + end; // loop through all players + end; // if it's time to draw them + + if PlayersPlay = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - else if PlayersPlay = 2 then begin + end + + else if PlayersPlay = 2 then begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - else if PlayersPlay = 3 then begin + end + + else if PlayersPlay = 3 then begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); if PlayerInfo.Playerinfo[1].Enabled then @@ -1271,7 +1150,8 @@ begin if PlayerInfo.Playerinfo[2].Enabled then SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); end - else if PlayersPlay = 4 then begin + + else if PlayersPlay = 4 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); @@ -1285,6 +1165,7 @@ begin SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); end; end; + if PlayersPlay = 6 then begin if ScreenAct = 1 then begin if PlayerInfo.Playerinfo[0].Enabled then @@ -1304,11 +1185,9 @@ begin end; end; end; - //PhrasenBonus - Line Bonus Mod End - +//PhrasenBonus - Line Bonus Mod End - // rysuje paski -// Log.LogStatus('Original notes', 'SingDraw'); +// resize the notes according to the difficulty level case Ini.Difficulty of 0: begin @@ -1518,11 +1397,11 @@ begin; end; //end Singbar Mod -//PhrasenBonus - Line Bonus 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 +Size: Integer; //Size of Popup begin if Alpha <> 0 then begin @@ -1542,14 +1421,17 @@ 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(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.TexNum); + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2]); glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index a79a16a2..79f82438 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -80,13 +80,17 @@ var ScreenPopupError: TScreenPopupError; //Notes - Tex_Left: array[0..6] of TTexture; - Tex_Mid: array[0..6] of TTexture; - Tex_Right: array[0..6] of TTexture; + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - Tex_BG_Left: array[1..6] of TTexture; - Tex_BG_Mid: array[1..6] of TTexture; - Tex_BG_Right: array[1..6] of TTexture; + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right Tex_Note_Star: TTexture; Tex_Note_Perfect_Star: TTexture; @@ -105,7 +109,7 @@ var //end Singbar Mod //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: TTexture; + Tex_SingLineBonusBack: array[0..8] of TTexture; //End PhrasenBonus - Line Bonus Mod const @@ -194,21 +198,25 @@ var begin // zaladowanie tekstur Log.LogStatus('Loading Textures', 'LoadTextures'); - Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); - Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); - Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? // P1-6 for P := 1 to 6 do begin LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Note Transparent', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Note Plain', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Note Transparent', Col); + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'BMP', 'Alpha Black Colored', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'BMP', 'Alpha Black Colored', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'BMP', 'Alpha Black Colored', Col); + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); end; Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); @@ -227,8 +235,11 @@ begin Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); //end Singbar Mod - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'JPG', 'Font Black', 0); + //Line Bonus PopUp + for P := 0 to 9 do + begin + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); + end; {//Set Texture to Font High Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 3a1c9dd4..98e1acb4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -33,7 +33,7 @@ type LineBonus_Text: string; LineBonus_Color: TRGB; LineBonus_Age: Integer; - + LineBonus_Rating: Integer; //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes LineBonus_TargetX: integer; LineBonus_TargetY: integer; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index b55a84dc..b883363f 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -12,65 +12,6 @@ type B: single; end; - {TSkin = record - GrayLeft: string; - GrayMid: string; - GrayRight: string; - - NoteBGLeft: string; - NoteBGMid: string; - NoteBGRight: string; - - NoteStar: string; - - Ball: string; - - - - //SingBar Mod - SingBarBack: string; - SingBarBar: string; - SingBarFront: string; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - SingLineBonusBack: string; - //PhrasenBonus - Line Bonus Mod - - - - WelcomeBG: string; - - Background: string; - ScoreBG: string; - MainStart: string; - MainEditor: string; - MainOptions: string; - MainExit: string; - MainBar: string; - Cursor: string; - - SongFade: string; - SongCover: string; - SongSelection: string; - - SelectSong: string; - Button: string; - Bar: string; - P: string; - Arrow: string; - Arrow2: string; - ButtonF: string; - Star: string; - Line: string; - -// ThemePath: string; - SkinReg: boolean; - SkinName: string; - SkinPath: string; - SkinColor: integer; - end;} - TThemeBackground = record Tex: string; end; @@ -315,7 +256,7 @@ type //TimeBar mod StaticTimeProgress: TThemeStatic; - TextTimeText : TThemeText; + TextTimeText : TThemeText; //eoa TimeBar mod StaticP1: TThemeStatic; @@ -838,60 +779,6 @@ begin LoadTheme(FileName, Color); - - {Skin.GrayLeft := 'Left Gray.bmp'; - Skin.GrayMid := 'Mid Gray.bmp'; - Skin.GrayRight := 'Right Gray.bmp'; - - Skin.NoteBGLeft := 'Note BG Left.bmp'; - Skin.NoteBGMid := 'Note BG Mid.bmp'; - Skin.NoteBGRight := 'Note BG Right.bmp'; - - Skin.NoteStar := 'Note Star.jpg'; - - - - //SingBar Mod - Skin.SingBarBack := 'Sing Bar Back.jpg'; - Skin.SingBarBar := 'Sing Bar Bar.jpg'; - Skin.SingBarFront := 'Sing Bar Front.jpg'; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Skin.SingLineBonusBack := 'Line Bonus PopUp.jpg'; - - - - -{ Skin.WelcomeBG := SkinPath + 'Welcome BG.jpg'; -// Skin.Background := SkinPath + 'Background.jpg'; - Skin.ScoreBG := SkinPath + 'Score BG.jpg'; -// Skin.GameStart := SkinPath + 'Game Start.jpg'; -// Skin.Editor := SkinPath + 'Editor.jpg'; -// Skin.Options := SkinPath + 'Options.jpg'; -// Skin.Exit := SkinPath + 'Exit.jpg'; - - Skin.MainStart := SkinPath + 'Main Solo.jpg'; - Skin.MainEditor := SkinPath + 'Main Multi.jpg'; - Skin.MainOptions := SkinPath + 'Main Options.jpg'; - Skin.MainExit := SkinPath + 'Main Exit.jpg'; - Skin.MainBar := SkinPath + 'Main Bar.jpg'; - Skin.Cursor := SkinPath + 'Main Cursor.jpg'; - - Skin.SongFade := SkinPath + 'Song Fade.jpg';}{ - Skin.SongCover := 'Song Cover.jpg'; - {Skin.SongSelection := SkinPath + 'Song Selection.jpg'; - - Skin.SelectSong := SkinPath + 'Select Song.jpg';}{ -// Skin.Button := SkinPath + 'MusicWheelItem song.jpg'; - Skin.Bar := 'Bar.jpg'; -{ Skin.P := SkinPath + 'P.jpg'; - Skin.Arrow := SkinPath + 'Arrow.jpg'; - Skin.Arrow2 := SkinPath + 'Arrow 2.jpg';}{ - Skin.ButtonF := 'Button.jpg'; - Skin.Ball := 'Ball3.bmp'; -{ Skin.Star := SkinPath + 'Star.bmp'; - Skin.Line := SkinPath + 'Line.jpg';} end; @@ -1144,51 +1031,51 @@ begin 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)); + 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.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); + ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); end; // Top5 ThemeLoadBasic(Top5, 'Top5'); - ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); + ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); - ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); - ThemeLoadTexts(Top5.TextName, 'Top5TextName'); - ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); + ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); + ThemeLoadTexts(Top5.TextName, 'Top5TextName'); + ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); // Options ThemeLoadBasic(Options, 'Options'); - ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame'); + 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.ButtonSound, 'OptionsButtonSound'); + ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics'); + ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes'); + ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced'); - ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); + ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); {{$IFDEF TRANSLATE} Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); @@ -1207,32 +1094,32 @@ begin // Options Game ThemeLoadBasic(OptionsGame, 'OptionsGame'); - ThemeLoadSelect(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); - ThemeLoadSelect(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); + 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'); + 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'); + 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'); + 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.SelectMicBoost, 'OptionsSoundSelectMicBoost'); ThemeLoadSelect(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); - ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); - ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); + ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); + ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); //Song Preview ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); @@ -1242,39 +1129,39 @@ begin // Options Lyrics ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); - ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); // Options Themes ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); - ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); + ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor'); - ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); + ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); // Options Record ThemeLoadBasic(OptionsRecord, 'OptionsRecord'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelL, 'OptionsRecordSelectSlideChannelL'); ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); - ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); + 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'); + 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'); @@ -1381,41 +1268,41 @@ begin //Load Party Score DecoTextures Object PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1); - PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); - PartyScore.DecoTextures.FirstTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); - PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); + PartyScore.DecoTextures.FirstTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); - PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); - PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); - PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); - PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); - PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); - PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); + 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'); + 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.StaticTeam1, 'PartyWinStaticTeam1'); + ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG'); ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco'); - ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); - ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); + ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); + ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco'); - ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); - ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); + ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); + ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco'); - ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); + ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); //Party Options ThemeLoadBasic(PartyOptions, 'PartyOptions'); @@ -1580,11 +1467,11 @@ begin ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0); ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeStatic.Z := ThemeIni.ReadFloat(Name, 'Z', 0); + ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0); ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0); ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0); - ThemeStatic.Typ := ThemeIni.ReadString(Name, 'Type', ''); + ThemeStatic.Typ := ThemeIni.ReadString(Name, 'Type', ''); ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); C := ColorExists(ThemeStatic.Color); @@ -1600,7 +1487,7 @@ begin ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1); //Reflection Mod - ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); DecimalSeparator := ','; @@ -1704,7 +1591,7 @@ begin 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); @@ -2049,18 +1936,6 @@ begin //New Theme-Color Patch End end; - - // pink -// Col := clRed; -// Color[C].ColR := (32 + Col and $FF) / (255 + 32); -// Color[C].ColG := (32 + Col div 256 and $FF) / (255 + 32); -// Color[C].ColB := (32 + Col div (256*256) and $FF) / (255 + 32); - - // purple -// Color[C].ColR := 220/255; -// Color[C].ColG := 95/255; -// Color[C].ColB := 220/255;} - end; function ColorSqrt(RGB: TRGB): TRGB; -- cgit v1.2.3 From 08ad90ec9f574c7dc153c8d40169f3a58c9beb9a Mon Sep 17 00:00:00 2001 From: mogguh Date: Mon, 10 Sep 2007 19:02:04 +0000 Subject: BugFix: Changed a 9 with a 8.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@384 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2 +- Game/Code/Classes/UGraphic.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 8cfa8d7e..94617583 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1431,7 +1431,7 @@ if Age < 5 then Size := Age * 10 else Size := 50; //New Method, Not Variable - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2]); + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 79f82438..0c022b8f 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -236,7 +236,7 @@ begin //end Singbar Mod //Line Bonus PopUp - for P := 0 to 9 do + for P := 0 to 8 do begin Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); end; -- cgit v1.2.3 From 6e7b96ca3a7d47b0441bed904a9b8bb25c3223de Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 12 Sep 2007 12:43:38 +0000 Subject: * added missed dependency PNGImage. * moved FUNCTION InitializePaths(), from uFiles to uMain as this is a more sane location for it. * updated files that used UFiles to point to UMain, and removed uFiles where its not needed. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@385 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCatCovers.pas | 7 ++- Game/Code/Classes/UCommandLine.pas | 11 +++- Game/Code/Classes/UCovers.pas | 64 +++++++++++---------- Game/Code/Classes/UFiles.pas | 113 ++++++++++++++++++------------------- Game/Code/Classes/UIni.pas | 9 ++- Game/Code/Classes/ULanguage.pas | 9 ++- Game/Code/Classes/ULog.pas | 12 +++- Game/Code/Classes/UMain.pas | 51 +++++++++++++++++ Game/Code/Classes/UPlaylist.pas | 9 ++- Game/Code/Classes/USongs.pas | 6 +- 10 files changed, 197 insertions(+), 94 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas index 34742902..d40b2564 100644 --- a/Game/Code/Classes/UCatCovers.pas +++ b/Game/Code/Classes/UCatCovers.pas @@ -24,7 +24,12 @@ var CatCovers: TCatCovers; implementation -uses IniFiles, SysUtils, Classes, UFiles, ULog; +uses IniFiles, + SysUtils, + Classes, + // UFiles, + UMain, + ULog; constructor TCatCovers.Create; begin diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 03229721..259c6e16 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -45,7 +45,10 @@ var Params: TCMDParams; implementation -uses SysUtils, UIni; + +uses SysUtils; +// uINI -- Nasty requirement... ( removed with permission of blindy ) + //------------- // Constructor - Create class, Reset Variables and Read Infos @@ -249,6 +252,7 @@ var I: integer; begin Result := -1; +{* JB - 12sep07 to remove uINI dependency //Search for Language For I := 0 to high(ILanguage) do @@ -257,6 +261,7 @@ begin Result := I; Break; end; +*} end; //------------- @@ -267,6 +272,7 @@ var I: integer; begin Result := -1; +{* JB - 12sep07 to remove uINI dependency //Search for Resolution For I := 0 to high(IResolution) do @@ -275,6 +281,7 @@ begin Result := I; Break; end; +*} end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 5b0a06d4..0740c143 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -34,7 +34,11 @@ var Covers: TCovers; implementation -uses UFiles, ULog, DateUtils; + +uses UMain, + // UFiles, + ULog, + DateUtils; constructor TCovers.Create; begin @@ -56,48 +60,50 @@ var Name: string; // Data: array of byte; begin - if FileExists(GamePath + 'covers.cache') then begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); - WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); - SetLength(Cover, 0); + SetLength(Cover, 0); - while not EOF(F) do begin - SetLength(Cover, Length(Cover)+1); + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); - BlockRead(F, W, 2); - Cover[High(Cover)].W := W; + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; - BlockRead(F, H, 2); - Cover[High(Cover)].H := H; + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; - BlockRead(F, Bits, 1); + BlockRead(F, Bits, 1); - Cover[High(Cover)].Size := W * H * (Bits div 8); + Cover[High(Cover)].Size := W * H * (Bits div 8); - // test -// W := 128; -// H := 128; -// Bits := 24; -// Seek(F, FilePos(F) + 3); + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); - BlockRead(F, NLen, 2); - SetLength(Name, NLen); + BlockRead(F, NLen, 2); + SetLength(Name, NLen); - BlockRead(F, Name[1], NLen); - Cover[High(Cover)].Name := Name; + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; - Cover[High(Cover)].Position := FilePos(F); - Seek(F, FilePos(F) + W*H*(Bits div 8)); + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); -// SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); -// BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); - end; + end; // While - CloseFile(F); + CloseFile(F); end; // fileexists end; diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index e6982a1a..008061a4 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -2,9 +2,12 @@ unit UFiles; interface -uses USongs, SysUtils, ULog, UMusic; +uses SysUtils, + ULog, + UMusic, + USongs; -procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs +//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header procedure ClearSong(var Song: TSong); //Clears Song Header values @@ -13,12 +16,13 @@ procedure ClearSong(var Song: TSong); //Clears Song Header values procedure ResetSingTemp; procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); -function LoadSong(Name: string): boolean; -function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +function LoadSong(Name: string): boolean; +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; var +{* //Absolute Paths GamePath: string; SoundPath: string; @@ -30,6 +34,7 @@ var LanguagesPath: string; PluginPath: string; PlayListPath: string; +*} SongFile: TextFile; // all procedures in this unit operates on this file FileLineNo: integer; //Line which is readed at Last, for error reporting @@ -41,57 +46,51 @@ var MultBPM: integer = 4; implementation -uses TextGL, UIni, UMain; +uses TextGL, + UIni, + UMain; +{* //-------------------- // Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist //-------------------- procedure InitializePaths; -var - Writeable: Boolean; -begin - GamePath := ExtractFilePath(ParamStr(0)); - - SoundPath := GamePath + 'Sounds\'; - SongPath := GamePath + 'Songs\'; - LogPath := GamePath; - ThemePath := GamePath + 'Themes\'; - ScreenshotsPath := GamePath + 'Screenshots\'; - CoversPath := GamePath + 'Covers\'; - LanguagesPath := GamePath + 'Languages\'; - PluginPath := GamePath + 'Plugins\'; - PlaylistPath := GamePath + 'Playlists\'; - - //After Setting Paths, make sure that Paths exist - If not DirectoryExists(SoundPath) then - Writeable := ForceDirectories(SoundPath); - - If Writeable And (not DirectoryExists(SongPath)) then - Writeable := ForceDirectories(SongPath); - - If Writeable And (not DirectoryExists(ThemePath)) then - Writeable := ForceDirectories(ThemePath); - If Writeable And (not DirectoryExists(ScreenshotsPath)) then - Writeable := ForceDirectories(ScreenshotsPath); - - If Writeable And (not DirectoryExists(CoversPath)) then - Writeable := ForceDirectories(CoversPath); - - If Writeable And (not DirectoryExists(LanguagesPath)) then - Writeable := ForceDirectories(LanguagesPath); - - If Writeable And (not DirectoryExists(PluginPath)) then - Writeable := ForceDirectories(PluginPath); + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + begin + aPathVar := aLocation; + + If DirectoryExists(aPathVar) then + lWriteable := ForceDirectories(aPathVar) + else + lWriteable := false; - If Writeable And (not DirectoryExists(PlaylistPath)) then - Writeable := ForceDirectories(PlaylistPath); + if not Writeable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; - if not Writeable then - Log.LogError('Error: Dir is Readonly'); +begin + GamePath := ExtractFilePath(ParamStr(0)); + + initialize_path( LogPath , GamePath ); + initialize_path( SoundPath , GamePath + 'Sounds\' ); + initialize_path( SongPath , GamePath + 'Songs\' ); + initialize_path( ThemePath , GamePath + 'Themes\' ); + initialize_path( ScreenshotsPath , GamePath + 'Screenshots\'); + initialize_path( CoversPath , GamePath + 'Covers\' ); + initialize_path( LanguagesPath , GamePath + 'Languages\' ); + initialize_path( PluginPath , GamePath + 'Plugins\' ); + initialize_path( PlaylistPath , GamePath + 'Playlists\' ); DecimalSeparator := ','; end; +*} //-------------------- // Clears Song Header values @@ -99,29 +98,29 @@ end; procedure ClearSong(var Song: TSong); begin //Main Information - Song.Title := ''; + Song.Title := ''; Song.Artist := ''; //Sortings: - Song.Genre := 'Unknown'; - Song.Edition := 'Unknown'; + Song.Genre := 'Unknown'; + Song.Edition := 'Unknown'; Song.Language := 'Unknown'; //Language Patch //Required Information - Song.Mp3 := ''; - Song.BPM := 0; - Song.GAP := 0; - Song.Start := 0; + Song.Mp3 := ''; + Song.BPM := 0; + Song.GAP := 0; + Song.Start := 0; Song.Finish := 0; //Additional Information Song.Background := ''; - Song.Cover := ''; - Song.Video := ''; - Song.VideoGAP := 0; - Song.NotesGAP := 0; + Song.Cover := ''; + Song.Video := ''; + Song.VideoGAP := 0; + Song.NotesGAP := 0; Song.Resolution := 4; - Song.Creator := ''; + Song.Creator := ''; end; //-------------------- @@ -791,4 +790,4 @@ begin CloseFile(SongFile); end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 846c0deb..67649a51 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -162,7 +162,14 @@ const IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); implementation -uses UFiles, SDL, ULanguage, USkins, URecord, UCommandLine; + +uses //UFiles, + UMain, + SDL, + ULanguage, + USkins, + URecord, + UCommandLine; procedure TIni.Load; var diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index 4649c089..5deed1f7 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -36,7 +36,14 @@ var implementation -uses UFiles, UIni, IniFiles, Classes, SysUtils, Windows, ULog; +uses UMain, + // UFiles, + UIni, + IniFiles, + Classes, + SysUtils, + Windows, + ULog; //---------- //Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 9d20d2f1..2233ec1b 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -45,7 +45,17 @@ var Log: TLog; implementation -uses UFiles, SysUtils, DateUtils, URecord, UTime, UIni, Windows, UCommandLine; + +uses + Windows, + SysUtils, + DateUtils, +// UFiles, + UMain, + URecord, + UTime, +// UIni, // JB - Seems to not be needed. + UCommandLine; destructor TLog.Free; begin diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 98e1acb4..43010bde 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -70,6 +70,18 @@ type var + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; + OGL: Boolean; Done: Boolean; Event: TSDL_event; @@ -80,6 +92,7 @@ var Player: array of TPlayer; PlayersPlay: integer; +procedure InitializePaths; procedure MainLoop; procedure CheckEvents; @@ -706,9 +719,47 @@ begin Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; Player[PlayerNum].LineBonus_TargetY := 30; //PhrasenBonus - Line Bonus Mod End +end; + +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; + + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + begin + aPathVar := aLocation; + + If DirectoryExists(aPathVar) then + lWriteable := ForceDirectories(aPathVar) + else + lWriteable := false; + + if not lWriteable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; + +begin + GamePath := ExtractFilePath(ParamStr(0)); + initialize_path( LogPath , GamePath ); + initialize_path( SoundPath , GamePath + 'Sounds\' ); + initialize_path( SongPath , GamePath + 'Songs\' ); + initialize_path( ThemePath , GamePath + 'Themes\' ); + initialize_path( ScreenshotsPath , GamePath + 'Screenshots\'); + initialize_path( CoversPath , GamePath + 'Covers\' ); + initialize_path( LanguagesPath , GamePath + 'Languages\' ); + initialize_path( PluginPath , GamePath + 'Plugins\' ); + initialize_path( PlaylistPath , GamePath + 'Playlists\' ); + DecimalSeparator := ','; end; end. diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index e3f68239..1e517ef7 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -59,7 +59,14 @@ type implementation -uses USongs, ULog, UFiles, UGraphic, UThemes, SysUtils; + +uses USongs, + ULog, + UMain, + //UFiles, + UGraphic, + UThemes, + SysUtils; //---------- //Create - Construct Class - Dummy for now diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index edf5b6df..7065024b 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -96,7 +96,11 @@ var implementation -uses UFiles, UIni, StrUtils; +uses StrUtils, + UFiles, + UMain, + UIni; + procedure TSongs.LoadSongList; begin -- cgit v1.2.3 From e3fc5e2c58302159b79e0e25e183aa3e75397a41 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Sep 2007 11:16:30 +0000 Subject: added switches.inc , which will contain compiler directives used ( at least ) for porting to linux. this file now contains compiler directive UseSerialPort, which is conditionally set depending on the compiler. at this point lazarus will not use the serial port ( LCD or Light ) units. however this functionality should be maintained at this point in delphi. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@390 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULCD.pas | 18 +++++++++++++++--- Game/Code/Classes/ULight.pas | 9 ++++++++- Game/Code/Classes/UMain.pas | 14 ++++++++++++-- 3 files changed, 35 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas index a3cdac73..52b0f96a 100644 --- a/Game/Code/Classes/ULCD.pas +++ b/Game/Code/Classes/ULCD.pas @@ -1,6 +1,7 @@ unit ULCD; interface +{$I switches.inc} type TLCD = class @@ -41,16 +42,24 @@ const implementation uses - SysUtils, zlportio, UTime; + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + UTime; procedure TLCD.WriteCommand(B: Byte); // Wysylanie komend sterujacych begin - if not HalfInterface then begin +{$IFDEF UseSerialPort} + if not HalfInterface then + begin zlioportwrite(Control, 0, $02); zlioportwrite(Data, 0, B); zlioportwrite(Control, 0, $03); - end else begin + end + else + begin zlioportwrite(Control, 0, $02); zlioportwrite(Data, 0, B and $F0); zlioportwrite(Control, 0, $03); @@ -66,11 +75,13 @@ begin Sleep(2) else TimeSleep(0.1); +{$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); @@ -89,6 +100,7 @@ begin TimeSleep(0.1); Inc(Position); +{$ENDIF} end; procedure TLCD.WriteString(S: string); diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 1fc4aba8..b9c7af9e 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -1,5 +1,6 @@ unit ULight; interface +{$I switches.inc} type TLight = class @@ -30,7 +31,11 @@ const implementation uses - SysUtils, zlportio, UTime; + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + UTime; constructor TLight.Create; begin @@ -45,8 +50,10 @@ end; procedure TLight.SetState(State: integer); begin + {$IFDEF UseSerialPort} if Enabled then PortWriteB($378, State); + {$ENDIF} end; procedure TLight.AutoSetState; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 43010bde..e89b4785 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,8 +1,16 @@ unit UMain; interface +{$I switches.inc} + uses SDL, UGraphic, UMusic, URecord, UTime, SysUtils, UDisplay, UIni, ULog, ULyrics, UScreenSing, - OpenGL12, zlportio {you can disable it and all PortWriteB calls}, ULCD, ULight, UThemes{, UScreenPopup}; + OpenGL12, + + {$IFDEF UseSerialPort} + zlportio {you can disable it and all PortWriteB calls}, + {$ENDIF} + + ULCD, ULight, UThemes{, UScreenPopup}; type TPlayer = record @@ -512,7 +520,9 @@ begin if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) end; - //PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$IFDEF UseSerialPort} + // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$ENDIF} end; procedure NewBeatD(Sender: TScreenSing); -- cgit v1.2.3 From 611f516b33a0c109893354593e28afe10f48e7db Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Sep 2007 12:07:57 +0000 Subject: major tidy up of Umusic ... removes mplayer unit and dependency. tidy up of other units in move to compile in lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@392 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCovers.pas | 12 +- Game/Code/Classes/ULyrics.pas | 27 +++-- Game/Code/Classes/UMusic.pas | 266 +++++------------------------------------ Game/Code/Classes/UTexture.pas | 16 ++- Game/Code/Classes/UThemes.pas | 4 + 5 files changed, 78 insertions(+), 247 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 0740c143..4040b4d8 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -1,7 +1,17 @@ unit UCovers; interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, UThemes, UTexture; + +uses OpenGL12, + Windows, + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; type TCover = record diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index c3b440bc..64762265 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -1,7 +1,14 @@ unit ULyrics; interface -uses SysUtils, OpenGL12, UMusic; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses SysUtils, + OpenGL12, + UMusic; type TWord = record @@ -57,6 +64,15 @@ type Italic: boolean; Text: string; // LCD + procedure AddWord(Text: string); // Moved from published, lazarus didnt like it + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + published property X: real write SetX; property Y: real write SetY; @@ -68,15 +84,6 @@ type property Scale: real write SetScale; property Style: integer write SetStyle; property FontStyle: integer write SetFStyle; - procedure AddWord(Text: string); - procedure AddCzesc(NrCzesci: integer); - - function SelectedLetter: integer; // LCD - function SelectedLength: integer; // LCD - - procedure Clear; - procedure Draw; - end; var diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 979ba4e5..f9c6457d 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -2,7 +2,16 @@ unit UMusic; interface -uses Classes, MPlayer, Windows, Messages, SysUtils, Forms, ULog, USongs, Bass;//, DXSounds; +uses Classes, + Windows, + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + ULog, + USongs, + Bass; procedure InitializeSound; @@ -22,17 +31,6 @@ type TMusic = class private -// MediaPlayer: TMediaPlayer; // It will be replaced by another component; -{ MediaPlayerStart: TMediaPlayer; // or maybe not if done this way ;) - MediaPlayerBack: TMediaPlayer; - MediaPlayerSwoosh: TMediaPlayer; - MediaPlayerChange: TMediaPlayer; - MediaPlayerOption: TMediaPlayer; - MediaPlayerClick: TMediaPlayer; - MediaPlayerDrum: TMediaPlayer; - MediaPlayerHihat: TMediaPlayer; - MediaPlayerClap: TMediaPlayer; - MediaPlayerShuffle: TMediaPlayer;} BassStart: hStream; // Wait, I've replaced this with BASS BassBack: hStream; // It has almost all features we need BassSwoosh: hStream; @@ -50,12 +48,8 @@ type Loaded: boolean; Loop: boolean; -// DXSound: TDXSound; -// Player: TcmxMp3; public Bass: hStream; - -// SoundCard: array of TSoundCard; procedure InitializePlayback; procedure InitializeRecord; procedure SetVolume(Volume: integer); @@ -86,7 +80,6 @@ type procedure CaptureStop; procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); procedure StopCard(Card: byte); - function LoadPlayerFromFile(var MediaPlayer: TMediaPlayer; Name: string): boolean; function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; //Equalizer @@ -105,11 +98,8 @@ type TMuzyka = record Path: string; Start: integer; // start of song in ms -// BPM: array of TBPM; -// Gap: real; IlNut: integer; DlugoscNut: integer; -// WartoscNut: integer; end; TCzesci = record @@ -138,27 +128,15 @@ type Tekst: string; FreeStyle: boolean; Wartosc: integer; // zwykla nuta x1, zlota nuta x2 - - - - end; end; end; TCzas = record // wszystko, co dotyczy aktualnej klatki -// BajtowTotal: integer; -// BajtowTeraz: integer; -// BajtowNaSek: integer; OldBeat: integer; // poprzednio wykryty beat w utworze AktBeat: integer; // aktualny beat w utworze MidBeat: real; // dokladny AktBeat - // should not be used -// OldHalf: integer; // poprzednio wykryta polowka -// AktHalf: integer; // aktualna polowka w utworze -// MidHalf: real; // dokladny AktHalf - // now we use this for super synchronization! // only used when analyzing voice OldBeatD: integer; // poprzednio wykryty beat w utworze @@ -178,11 +156,9 @@ type Teraz: real; // aktualny czas w utworze Razem: real; // caly czas utworu -// TerazSek: integer; end; var - Form: TForm; Music: TMusic; // muzyka @@ -196,6 +172,10 @@ var fHWND: Thandle; +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); @@ -230,25 +210,8 @@ begin // BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); // BASS_SetConfig(BASS_CONFIG_BUFFER, 100); -{ MediaPlayer := TMediaPlayer.Create( nil ); - MediaPlayer.ParentWindow := fHWND; - MediaPlayer.Wait := true;} - Log.LogStatus('Loading Sounds', 'Music Initialize'); -{ LoadPlayerFromFile(MediaPlayerStart, SoundPath + 'Common Start.mp3'); - LoadPlayerFromFile(MediaPlayerBack, SoundPath + 'Common Back.mp3'); - LoadPlayerFromFile(MediaPlayerSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadPlayerFromFile(MediaPlayerChange, SoundPath + 'select music change music.mp3'); - LoadPlayerFromFile(MediaPlayerOption, SoundPath + 'option change col.mp3'); - LoadPlayerFromFile(MediaPlayerClick, SoundPath + 'rimshot022b.mp3'); - - LoadPlayerFromFile(MediaPlayerDrum, SoundPath + 'bassdrumhard076b.mp3'); - LoadPlayerFromFile(MediaPlayerHihat, SoundPath + 'hihatclosed068b.mp3'); - LoadPlayerFromFile(MediaPlayerClap, SoundPath + 'claps050b.mp3'); - - LoadPlayerFromFile(MediaPlayerShuffle, SoundPath + 'Shuffle.mp3');} - Log.BenchmarkStart(4); LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); @@ -370,9 +333,6 @@ function TMusic.Open(Name: string): boolean; begin Loaded := false; if FileExists(Name) then begin -{ MediaPlayer.FileName := Name; - MediaPlayer.Open;} - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); Loaded := true; //Set Max Volume @@ -380,15 +340,11 @@ begin end; Result := Loaded; - -// Player := TcmxMp3.Create(Name); end; procedure TMusic.Rewind; begin if Loaded then begin -// MediaPlayer.Position := 0; - end; end; @@ -396,18 +352,17 @@ procedure TMusic.MoveTo(Time: real); var bytes: integer; begin -// if Loaded then begin -// MediaPlayer.StartPos := Round(Time); bytes := BASS_ChannelSeconds2Bytes(Bass, Time); BASS_ChannelSetPosition(Bass, bytes); -// end; end; procedure TMusic.Play; begin - if Loaded then begin -// MediaPlayer.Play; - if Loop then BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class + BASS_ChannelPlay(Bass, False); // for setting position before playing end; end; @@ -422,17 +377,11 @@ end; procedure TMusic.Stop; begin Bass_ChannelStop(Bass); -// Bass_StreamFree(Bass); -// if ModeStr[MediaPlayer.Mode] = 'Playing' then begin -// MediaPlayer.Stop; -// end; end; procedure TMusic.Close; begin Bass_StreamFree(Bass); -// Player.Free; -// MediaPlayer.Close; end; function TMusic.Length: real; @@ -441,129 +390,76 @@ var begin Result := 60; - bytes := BASS_ChannelGetLength(Bass); + bytes := BASS_ChannelGetLength(Bass); Result := BASS_ChannelBytes2Seconds(Bass, bytes); - -{ if Assigned(MediaPlayer) then begin - if Loaded then Result := MediaPlayer.Length / 1000; - end;} -// if Assigned(Player) then -// Result := Player.LengthInSeconds; end; function TMusic.Position: real; var bytes: integer; begin - Result := 0;//MediaPlayer.Position / 1000; - bytes := BASS_ChannelGetPosition(BASS); + Result := 0; + bytes := BASS_ChannelGetPosition(BASS); Result := BASS_ChannelBytes2Seconds(BASS, bytes); end; function TMusic.Finished: boolean; begin Result := false; -// if ModeStr[MediaPlayer.Mode] = 'Stopped' then Result := true; - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then begin -// beep; + + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin Result := true; end; end; -{function myeffect( chan : integer; stream : Pointer; len : integer; udata : Pointer ): Pointer; cdecl; -var - dane: pwordarray; - pet: integer; - Prev: smallint; - PrevNew: smallint; -begin - dane := stream; - Prev := 0; - for pet := 0 to len div 2 -1 do begin - PrevNew := Dane[Pet]; - -// Dane[pet] := Round(PrevNew*1/8 + Prev*7/8); - - Prev := Dane[Pet]; - end; -end;} - procedure TMusic.PlayStart; -{var - Music: PMix_Chunk;} begin -{ Mix_OpenAudio(44100, 16, 1, 16*1024); - Music := Mix_LoadWAV('D:\Rozne\UltraStar\Old\Boys - Hej Sokoly 30s.wav'); - Mix_RegisterEffect(0, myeffect, nil, 0); - Mix_PlayChannel(0, Music, 0);} - -// MediaPlayerStart.Rewind; -// MediaPlayerStart.Play; BASS_ChannelPlay(BassStart, True); end; procedure TMusic.PlayBack; begin -// MediaPlayerBack.Rewind; -// MediaPlayerBack.Play; -// if not BASS_ChannelPlay(BassBack, True);// then -// Application.MessageBox ('Error playing stream!', 'Error'); end; procedure TMusic.PlaySwoosh; begin -// MediaPlayerSwoosh.Rewind; -// MediaPlayerSwoosh.Play; BASS_ChannelPlay(BassSwoosh, True); end; procedure TMusic.PlayChange; begin -// MediaPlayerChange.Rewind; -// MediaPlayerChange.Play; BASS_ChannelPlay(BassChange, True); end; procedure TMusic.PlayOption; begin -// MediaPlayerOption.Rewind; -// MediaPlayerOption.Play; BASS_ChannelPlay(BassOption, True); end; procedure TMusic.PlayClick; begin -// MediaPlayerClick.Rewind; -// MediaPlayerClick.Play; BASS_ChannelPlay(BassClick, True); end; procedure TMusic.PlayDrum; begin -// MediaPlayerDrum.Rewind; -// MediaPlayerDrum.Play; BASS_ChannelPlay(BassDrum, True); end; procedure TMusic.PlayHihat; begin -// MediaPlayerHihat.Rewind; -// MediaPlayerHihat.Play; BASS_ChannelPlay(BassHihat, True); end; procedure TMusic.PlayClap; begin -// MediaPlayerClap.Rewind; -// MediaPlayerClap.Play; BASS_ChannelPlay(BassClap, True); end; procedure TMusic.PlayShuffle; begin -// MediaPlayerShuffle.Rewind; -// MediaPlayerShuffle.Play; BASS_ChannelPlay(BassShuffle, True); end; @@ -582,35 +478,6 @@ begin for S := 0 to High(Sound) do Sound[S].BufferLong[0].Clear; -{ case PlayersPlay of - 1: begin - CaptureCard(0, 0, 1, 0); - end; - 2: begin - if Ini.TwoPlayerMode = 0 then begin - CaptureCard(0, 0, 1, 2); - end else begin - CaptureCard(0, 0, 1, 0); - CaptureCard(1, 1, 2, 0); - end; - end; - 3: begin - CaptureCard(0, 0, 1, 2); - CaptureCard(1, 1, 3, 0); - end; - end; // case} - -// CaptureCard(0, 0, 0, 0); -// end; - - {for SC := 0 to High(SoundCard) do begin - P1 := Ini.SoundCard[SC, 1]; - P2 := Ini.SoundCard[SC, 2]; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - CaptureCard(SC, P1, P2); - end; } - // 0.5.2: new for SC := 0 to High(Ini.CardList) do begin P1 := Ini.CardList[SC].ChannelL; P2 := Ini.CardList[SC].ChannelR; @@ -627,31 +494,7 @@ var P1: integer; P2: integer; begin -{ if RecordSystem = 1 then begin - case PlayersPlay of - 1: begin - StopCard(0); - end; - 2: begin - if Ini.TwoPlayerMode = 0 then begin - StopCard(0); - end else begin - StopCard(0); - StopCard(1); - end; - end; - 3: begin - StopCard(0); - StopCard(1); - end; - end; - end;} - - {for SC := 0 to High(SoundCard) do begin - StopCard(SC); - end; } - // 0.5.2 for SC := 0 to High(Ini.CardList) do begin P1 := Ini.CardList[SC].ChannelL; P2 := Ini.CardList[SC].ChannelR; @@ -686,26 +529,10 @@ begin Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - end else begin - - //SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - - {if SoundCard[RecordI].BassRecordStream = 0 then begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_INIT then ErrorMsg := 'Not successfully called'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'Recording is already in progress'; - if Error = BASS_ERROR_NOTAVAIL then ErrorMsg := 'The recording device is not available'; - if Error = BASS_ERROR_FORMAT then ErrorMsg := 'The specified format is not supported'; - if Error = BASS_ERROR_MEM then ErrorMsg := 'There is insufficent memory'; - if Error = BASS_ERROR_UNKNOWN then ErrorMsg := 'Unknown'; - - Log.LogError('Error creating record stream [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - end; } + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); end; end; @@ -715,41 +542,12 @@ begin BASS_RecordFree; end; -function TMusic.LoadPlayerFromFile(var MediaPlayer: TMediaPlayer; Name: string): boolean; -begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadPlayerFromFile'); - if FileExists(Name) then begin - try - MediaPlayer := TMediaPlayer.Create( nil ); - except - Log.LogError('Failed to create MediaPlayer', 'LoadPlayerFromFile'); - end; - try - MediaPlayer.ParentWindow := fHWND; - MediaPlayer.Wait := true; - MediaPlayer.FileName := Name; - MediaPlayer.DeviceType := dtAutoSelect; - MediaPlayer.Display := nil; - except - Log.LogError('Failed setting MediaPlayer: ' + MediaPlayer.ErrorMessage, 'LoadPlayerFromFile'); - end; - try - MediaPlayer.Open; - except - Log.LogError('Failed to open using MediaPlayer', 'LoadPlayerFromFile'); - end; - end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadPlayerFromFile'); - exit; - end; -end; - function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; var L: Integer; begin if FileExists(Name) then begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadPlayerFromFile'); + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); try hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); //Add CustomSound @@ -758,10 +556,10 @@ begin CustomSounds[L].Filename := Name; CustomSounds[L].Handle := hStream; except - Log.LogError('Failed to open using BASS', 'LoadPlayerFromFile'); + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); end; end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadPlayerFromFile'); + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); exit; end; end; diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index dc1f9fc2..f79f66d6 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,19 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; + +uses OpenGL12, + Windows, + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + JPEG, + PNGImage, + {$ENDIF} + UThemes; + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -974,4 +986,4 @@ begin end; end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index b883363f..b2e2b01e 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -2,6 +2,10 @@ unit UThemes; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + uses IniFiles, SysUtils, Classes; -- cgit v1.2.3 From 433a1b7339e2bf96f3b0bb4c98b8c799c6540027 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Sep 2007 13:19:20 +0000 Subject: changes in order to compile in lazarus... minor tidy ups and removal of big old comment blocks.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@394 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDLLManager.pas | 9 ++- Game/Code/Classes/UDataBase.pas | 5 ++ Game/Code/Classes/UDraw.pas | 10 +++- Game/Code/Classes/UGraphic.pas | 76 +++++++++++++++++++++---- Game/Code/Classes/UIni.pas | 7 ++- Game/Code/Classes/ULanguage.pas | 5 ++ Game/Code/Classes/ULight.pas | 28 ++++++++- Game/Code/Classes/UMain.pas | 5 ++ Game/Code/Classes/UParty.pas | 5 ++ Game/Code/Classes/UPlaylist.pas | 5 ++ Game/Code/Classes/URecord.pas | 117 ++++++++++++++++---------------------- Game/Code/Classes/USkins.pas | 5 ++ Game/Code/Classes/UTexture.pas | 5 ++ Game/Code/Classes/UVideo.pas | 27 ++++++++- 14 files changed, 226 insertions(+), 83 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 4b8838b9..0d328c37 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -1,7 +1,14 @@ unit UDLLManager; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + interface -uses ModiSDK, UFiles; + +uses ModiSDK, + UFiles; type TDLLMan = class diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index b8b41bc1..009d0d63 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -2,6 +2,11 @@ unit UDataBase; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + uses USongs, SQLiteTable3; //-------------------- diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 94617583..cbfafbe6 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,7 +1,15 @@ unit UDraw; interface -uses UThemes, ModiSDK, UGraphicClasses, dialogs; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses UThemes, + ModiSDK, + UGraphicClasses; + // dialogs; procedure SingDraw; procedure SingModiDraw (PlayerInfo: TPlayerInfo); diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 0c022b8f..eb7dde8e 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,16 +1,59 @@ unit UGraphic; interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + uses - SDL, OpenGL12, UTexture, TextGL, ULog, SysUtils, ULyrics, UScreenLoading, - UScreenWelcome, UScreenMain, UScreenName, UScreenLevel, UScreenOptions, UScreenOptionsGame, - UScreenOptionsGraphics, UScreenOptionsSound, UScreenOptionsLyrics, UScreenOptionsThemes, UScreenOptionsRecord, UScreenOptionsAdvanced, - UScreenSong, UScreenSing, UScreenScore, UScreenTop5, UScreenEditSub, - UScreenEdit, UScreenEditConvert, UScreenEditHeader, UScreenOpen, UThemes, USkins, UScreenSongMenu, UScreenSongJumpto, - {Party Screens} UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer, - {Stats Screens} UScreenStatMain, UScreenStatDetail, - {CreditsScreen} UScreenCredits, - {Popup for errors, etc.} UScreenPopup; + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; type TRecR = record @@ -188,9 +231,20 @@ function LoadingThreadFunction: integer; implementation -uses UMain, UIni, UDisplay, UCommandLine, Graphics, Classes, Windows; + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + Classes, + Windows; procedure LoadTextures; + + var P: integer; R, G, B: real; @@ -253,7 +307,7 @@ end; procedure Initialize3D (Title: string); var - Icon: TIcon; +// Icon: TIcon; Res: TResourceStream; ISurface: PSDL_Surface; Pixel: PByteArray; diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 67649a51..cd5c3716 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -1,6 +1,11 @@ unit UIni; interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + uses IniFiles, ULog, SysUtils; type @@ -768,4 +773,4 @@ begin end; end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index 5deed1f7..f693694b 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -2,6 +2,11 @@ unit ULanguage; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + type TLanguageEntry = record ID: string; diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index b9c7af9e..74681a85 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -36,6 +36,32 @@ uses zlportio, {$ENDIF} UTime; + +{$IFDEF FPC} + function GetTime: TDateTime; + {$IFDEF MSWINDOWS} + var + SystemTime: TSystemTime; + begin + GetLocalTime(SystemTime); + with SystemTime do + Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); + end; + {$ENDIF} + {$IFDEF LINUX} + var + T: TTime_T; + TV: TTimeVal; + UT: TUnixTime; + begin + gettimeofday(TV, nil); + T := TV.tv_sec; + localtime_r(@T, UT); + Result := EncodeTime(UT.tm_hour, UT.tm_min, UT.tm_sec, TV.tv_usec div 1000); + end; + {$ENDIF} +{$ENDIF} + constructor TLight.Create; begin @@ -44,7 +70,7 @@ end; procedure TLight.Enable; begin - Enabled := true; + Enabled := true; LastTime := GetTime; end; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index e89b4785..646724df 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,6 +1,11 @@ unit UMain; interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses SDL, UGraphic, UMusic, URecord, UTime, SysUtils, UDisplay, UIni, ULog, ULyrics, UScreenSing, diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 7bf3dd1b..9be0df3e 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -2,6 +2,11 @@ unit UParty; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + uses ModiSDK; type diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 1e517ef7..3f89ffed 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -2,6 +2,11 @@ unit UPlaylist; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + type TPlaylistItem = record Artist: String; diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 6ce83c0a..03c87a35 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -1,7 +1,13 @@ unit URecord; interface -uses Classes, Math, SysUtils, {DXSounds, Wave, }UMusic, UIni, BASS; + +uses Classes, + Math, + SysUtils, + UMusic, + UIni, + BASS; type TSound = class @@ -11,8 +17,6 @@ type Num: integer; n: integer; // length of Signal to analyze -// Spectrum: array[1..8192] of single; // sound buffer from above as FFT -// Spektogram: array[0..100] of TSpekt; // FFT(t) // pitch detection SzczytJest: boolean; // czy jest szczyt @@ -63,7 +67,7 @@ var Recording: TRecord; implementation -uses UMain, ULog; +uses UMain; procedure TSound.ProcessNewBuffer; var @@ -87,7 +91,8 @@ begin BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L); // process BufferLong - if Ini.SavePlayback = 1 then begin + if Ini.SavePlayback = 1 then + begin BufferNew.Seek(0, soBeginning); BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); end; @@ -110,32 +115,29 @@ var S: integer; // Signal Threshold: real; // threshold begin -// Log.LogAnalyze('[Analyze by Autocorrelation]'); SzczytJest := false; // find maximum volume of first 1024 words of signal MaxV := 0; - for S := 1 to 1024 do begin // 0.5.2: fix. was from 0 to 1023 -// Log.LogDebug('1'); -// Log.LogDebug(IntTostr(S)); + for S := 1 to 1024 do // 0.5.2: fix. was from 0 to 1023 + begin V := Abs(BufferArray[S]) / $10000; -// Log.LogDebug('2'); -// Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray))); - if V > MaxV then MaxV := V; -// Log.LogDebug('3'); -// Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray))); - end; + if V > MaxV then + MaxV := V; + end; // prepare to analyze MaxW := 0; // analyze all 12 halftones - for T := 0 to 35 do begin // to 11, then 23, now 35 (for Whitney and my high voice) + for T := 0 to 35 do // to 11, then 23, now 35 (for Whitney and my high voice) + begin F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81 Wages[T] := AnalyzeAutocorrelationFreq(F); - if Wages[T] > MaxW then begin // this frequency has better wage + if Wages[T] > MaxW then + begin // this frequency has better wage MaxW := Wages[T]; MaxT := T; end; @@ -149,20 +151,13 @@ begin 3: Threshold := 0.2; end; - //Log.LogDebug('Sound -> AnalyzeByAutocorrelation: MaxV='+floattostr(maxv)+', Threshold='+floattostr(threshold)); - if MaxV >= Threshold then begin // found acceptable volume // 0.1 + if MaxV >= Threshold then + begin // found acceptable volume // 0.1 SzczytJest := true; TonGamy := MaxT mod 12; Ton := MaxT mod 12; end; -// Log.LogAnalyze('--> Weight: ') -// Log.LogAnalyze('--> Selected: ' + BoolToStr(SzczytJest, true) + -// ', TonGamy: ' + IntToStr(Ton) + -// ', MaxV: ' + FloatToStr(MaxV)); -// Log.LogAnalyze(''); - - end; function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference @@ -175,25 +170,14 @@ var begin // we use Signal as source Count := 0; - Il := 0; - Src := 1; - Move := Round(44100/Freq); - Dst := Src + Move; - - // ver 1 - sample 1 and compare n-times -{ while (Src <= Move) do begin // process by moving Src by one - while (Dst < n) do begin // process up to n (4KB) of Signal - Count := Count + Abs(Signal[Src] - Signal[Dst]) / $10000; - Inc(Dst, Move); - Inc(Il); - end; - - Inc(Src); - Dst := Src + Move; - end;} + Il := 0; + Src := 1; + Move := Round(44100/Freq); + Dst := Src + Move; // ver 2 - compare in vertical - while (Dst < n) do begin // process up to n (4KB) of Signal + while (Dst < n) do + begin // process up to n (4KB) of Signal Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000; Inc(Src); Inc(Dst); @@ -208,8 +192,6 @@ var L: integer; S: integer; PB: pbytearray; - PW: pwordarray; - SI: smallintarray; PSI: psmallintarray; I: integer; Skip: integer; @@ -217,8 +199,6 @@ var P2: integer; Boost: byte; begin -// Log.LogDebug('Record -> GetMicrophone: len='+inttstr(len)); - // set boost case Ini.MicBoost of 0: Boost := 1; @@ -230,7 +210,8 @@ begin // boost buffer L := Len div 2; // number of samples PSI := Buffer; - for S := 0 to L-1 do begin + for S := 0 to L-1 do + begin I := PSI^[S] * Boost; if I > 32767 then I := 32767; // 0.5.0: limit if I < -32768 then I := -32768; // 0.5.0: limit @@ -241,37 +222,36 @@ begin P1 := (user and 255) - 1; P2 := (user div 256) - 1; -// Log.LogDebug('Record -> GetMicrophone: P1='+inttostr(p1)+', P2='+inttostr(p2)); // 2 players USB mic, left channel - if P1 >= 0 then begin - L := Len div 4; // number of samples + if P1 >= 0 then + begin + L := Len div 4; // number of samples PB := Buffer; -// Log.LogDebug('Record -> GetMicrophone -> Sound[P1].BufferNew.Clear'); + Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting - for S := 1 to L do begin + for S := 1 to L do + begin Sound[P1].BufferNew.Write(PB[(S-1)*4], 2); end; Sound[P1].ProcessNewBuffer; end; // 2 players USB mic, right channel -// if Ini.Debug = 0 then Skip := 2 -// else Skip := 0; Skip := 2; - if P2 >= 0 then begin + if P2 >= 0 then + begin L := Len div 4; // number of samples PB := Buffer; Sound[P2].BufferNew.Clear; - for S := 1 to L do begin + for S := 1 to L do + begin Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2); end; Sound[P2].ProcessNewBuffer; end; -// Log.LogDebug('Record -> GetMicrophone -> Finish'); - Result := true; end; @@ -283,6 +263,7 @@ var InputName: PChar; Flags: integer; No: integer; + function isDuplicate(Desc: String): Boolean; var I: Integer; @@ -306,15 +287,17 @@ begin SC := 0; Descr := BASS_RecordGetDeviceDescription(SC); - while (Descr <> '') do begin + while (Descr <> '') do + begin //If there is another SoundCard with the Same ID, Search an available Name if (IsDuplicate(Descr)) then begin No:= 1; //Count of SoundCards with same Name Repeat - Inc(No) + Inc(No) Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + //Set Description Descr := Descr + ' (' + InttoStr(No) + ')'; end; @@ -333,12 +316,12 @@ begin SoundCard[SC].Input[SCI].Name := InputName; // process each input - while (InputName <> nil) do begin + while (InputName <> nil) do + begin Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then begin - + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then + begin SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; end; @@ -346,18 +329,18 @@ begin if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then SoundCard[SC].MicInput := SCI; - Inc(SCI); InputName := BASS_RecordGetInputName(SCI); end; - BASS_RecordFree; Inc(SC); Descr := BASS_RecordGetDeviceDescription(SC); end; // while end; + + end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 3bcd9357..a5f618ff 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -1,5 +1,10 @@ unit USkins; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + interface type diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f79f66d6..d1ca0917 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,5 +1,10 @@ unit UTexture; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + // Plain (alpha = 1) // Transparent // Transparent Range diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 8e2fc446..c97057ac 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -5,6 +5,10 @@ # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # #############################################################################} +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + //{$define DebugDisplay} // uncomment if u want to see the debug stuff {$define DebugFrames} {$define Info} @@ -13,7 +17,20 @@ unit UVideo; interface -uses SDL, UGraphicClasses, textgl, avcodec, avformat, avutil, math, OpenGL12, SysUtils, UIni, dialogs; + +uses SDL, + UGraphicClasses, + textgl, + avcodec, + avformat, + avutil, + math, + OpenGL12, + SysUtils, + {$ifdef DebugDisplay} + dialogs, + {$ENDIF} + UIni; procedure Init; procedure FFmpegOpenFile(FileName: pAnsiChar); @@ -64,6 +81,7 @@ begin errnum:=av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); if(errnum <> 0) then begin +{$ifdef DebugDisplay} case errnum of AVERROR_UNKNOWN: showmessage('failed to open file '+Filename+#13#10+'AVERROR_UNKNOWN'); AVERROR_IO: showmessage('failed to open file '+Filename+#13#10+'AVERROR_IO'); @@ -74,6 +92,7 @@ begin AVERROR_NOTSUPP: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOTSUPP'); else showmessage('failed to open file '+Filename+#13#10+'Error number: '+inttostr(Errnum)); end; +{$ENDIF} Exit; end else begin @@ -90,7 +109,9 @@ begin VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); end else begin +{$ifdef DebugDisplay} showmessage('found no video stream'); +{$ENDIF} av_close_input_file(VideoFormatContext); Exit; end; @@ -98,7 +119,9 @@ begin begin errnum:=avcodec_open(VideoCodecContext, VideoCodec); end else begin +{$ifdef DebugDisplay} showmessage('no matching codec found'); +{$ENDIF} avcodec_close(VideoCodecContext); av_close_input_file(VideoFormatContext); Exit; @@ -125,7 +148,9 @@ begin if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, VideoCodecContext^.width, VideoCodecContext^.height) else begin +{$ifdef DebugDisplay} showmessage('failed to allocate video buffer'); +{$endif} av_free(AVFrameRGB); av_free(AVFrame); avcodec_close(VideoCodecContext); -- cgit v1.2.3 From 62c82114318ed04ce42617fa9ce2e179834dbda4 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 11:44:10 +0000 Subject: added UCommon ( in classes ) for lazarus... common functions needed for lazarus ( and others ) can be put in here. also this now compiles on lazarus.. ( dosnt link yet... but I dont get any critical compiler errors ) tested to compile in my delphi, and basic functionality is fine. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@395 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 11 +++- Game/Code/Classes/UCommon.pas | 98 +++++++++++++++++++++++++++++++++++ Game/Code/Classes/UCovers.pas | 4 ++ Game/Code/Classes/UDraw.pas | 1 - Game/Code/Classes/UFiles.pas | 9 ++++ Game/Code/Classes/UGraphicClasses.pas | 14 ++++- Game/Code/Classes/ULog.pas | 4 ++ Game/Code/Classes/UMusic.pas | 26 ++++++++-- Game/Code/Classes/USongs.pas | 6 +++ Game/Code/Classes/UTexture.pas | 45 +++++++++++----- Game/Code/Classes/UThemes.pas | 7 ++- Game/Code/Classes/UVideo.pas | 9 ++-- 12 files changed, 209 insertions(+), 25 deletions(-) create mode 100644 Game/Code/Classes/UCommon.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 0f4ae82e..aa5fa18b 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -2,7 +2,16 @@ unit TextGL; interface -uses OpenGL12, SDL, UTexture, Classes, ULog; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses OpenGL12, + SDL, + UTexture, + Classes, + ULog; procedure BuildFont; // Build Our Bitmap Font procedure KillFont; // Delete The Font diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas new file mode 100644 index 00000000..f25e025b --- /dev/null +++ b/Game/Code/Classes/UCommon.pas @@ -0,0 +1,98 @@ +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + windows; + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(Wnd: HWND); + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; +{$ENDIF} + +implementation + +{$IFDEF FPC} + +function MaxValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result < Data[I] then + Result := Data[I]; +end; + +function MinValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result > Data[I] then + Result := Data[I]; +end; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin +RandomRange := Random(aMax-aMin) + aMin ; +end; + + + +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin +(* + UtilWindowClass.hInstance := HInstance; +{$IFDEF PIC} + UtilWindowClass.lpfnWndProc := @DefWindowProc; +{$ENDIF} + ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); + if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then + begin + if ClassRegistered then + Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); + Windows.RegisterClass(UtilWindowClass); + end; + Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil); +*) + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil); + +(* + if Assigned(Method) then + SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); +*) +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); + +// if Instance <> @DefWindowProc then +// FreeObjectInstance(Instance); +end; + +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 4040b4d8..efed1435 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -2,6 +2,10 @@ unit UCovers; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses OpenGL12, Windows, Math, diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index cbfafbe6..a28f1efc 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -9,7 +9,6 @@ interface uses UThemes, ModiSDK, UGraphicClasses; - // dialogs; procedure SingDraw; procedure SingModiDraw (PlayerInfo: TPlayerInfo); diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 008061a4..bbb22136 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -2,6 +2,10 @@ unit UFiles; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses SysUtils, ULog, UMusic, @@ -108,7 +112,12 @@ begin //Required Information Song.Mp3 := ''; + {$IFDEF FPC} + Song.BPM := NULL; + {$ELSE} Song.BPM := 0; + {$ENDIF} + Song.GAP := 0; Song.Start := 0; Song.Finish := 0; diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 83d192d6..761ec058 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -3,6 +3,7 @@ unit UGraphicClasses; interface uses UTexture; + const DelayBetweenFrames : Cardinal = 60; type @@ -79,7 +80,18 @@ type var GoldenRec : TEffectManager; implementation -uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, math, dialogs; + +uses sysutils, + Windows, + OpenGl12, + 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); diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 2233ec1b..4a18b8e2 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -2,6 +2,10 @@ unit ULog; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses Classes; type diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index f9c6457d..be585ee1 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -2,6 +2,11 @@ unit UMusic; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + uses Classes, Windows, Messages, @@ -180,7 +185,14 @@ const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); implementation -uses UGraphic, URecord, UFiles, UIni, UMain, UThemes; + +uses UCommon, + UGraphic, + URecord, + UFiles, + UIni, + UMain, + UThemes; procedure InitializeSound; begin @@ -195,12 +207,18 @@ var begin Log.BenchmarkStart(4); Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + Loaded := false; - Loop := false; - fHWND := AllocateHWND( nil); + Loop := false; + + fHWND := AllocateHWND( nil); // TODO : JB - can we do something different here ?? lazarus didnt like this function - if not BASS_Init(1, 44100, 0, fHWND, nil) then begin + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB find a way to do this nice.. Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} Exit; end; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 7065024b..f5afbee2 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,6 +1,12 @@ unit USongs; interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + uses SysUtils, ULog, UTexture, UCatCovers; type diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index d1ca0917..4eb00b4b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,10 +1,5 @@ unit UTexture; -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - // Plain (alpha = 1) // Transparent // Transparent Range @@ -17,16 +12,24 @@ unit UTexture; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + uses OpenGL12, Windows, Math, Classes, SysUtils, - {$IFNDEF FPC} Graphics, + + {$IFDEF FPC} + lazjpeg, + {$ELSE} JPEG, PNGImage, {$ENDIF} + UCommon, UThemes; @@ -192,11 +195,19 @@ var begin hls[0]:=hue; - clr[0]:=src[0]/255; clr[1]:=src[1]/255; clr[2]:=src[2]/255; + clr[0] := src[0]/255; + clr[1] := src[1]/255; + clr[2] := src[2]/255; + //calculate luminance and saturation from rgb - hls[1]:=maxvalue(clr); //l:=... - delta:=hls[1]-minvalue(clr); - if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + // calc new rgb from our hls (h from color, l ans s from pixel) // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense begin @@ -287,7 +298,10 @@ var Res: TResourceStream; TextureB: TBitmap; TextureJ: TJPEGImage; + {$IFNDEF FPC} TexturePNG: TPNGObject; + {$ENDIF} + TextureAlpha: array of byte; AlphaPtr: PByte; TransparentColor: TColor; @@ -306,6 +320,8 @@ var RGBPtr: PByte; myHue: Double; begin + {$IFNDEF FPC} // TODO : JB eeeew this is a nasty one... + // but lazarus implementation scanlines is different :( Log.BenchmarkStart(4); Mipmapping := true; @@ -347,7 +363,10 @@ begin TextureJ.Free; end - else if Format = 'PNG' then begin + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB - fix this for lazarus.. TexturePNG := TPNGObject.Create; if FromRegistry then TexturePNG.LoadFromStream(Res) else begin @@ -389,6 +408,7 @@ begin setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) // transparent png hack end TexturePNG.Free; + {$ENDIF} end; if FromRegistry then Res.Free; @@ -872,7 +892,8 @@ begin if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - end; // logerror + end; // logerror + {$ENDIF} end; {procedure ResizeTexture(s: pbytearray; d: pbytearray); diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index b2e2b01e..6436ee39 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -7,7 +7,9 @@ interface {$ENDIF} uses -IniFiles, SysUtils, Classes; + IniFiles, + SysUtils, + Classes; type TRGB = record @@ -739,7 +741,8 @@ uses {{$IFDEF TRANSLATE} ULanguage, {{$ENDIF} -USkins, UIni, Dialogs; + USkins, + UIni; constructor TTheme.Create(FileName: string); begin diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index c97057ac..4c8a4076 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -5,10 +5,6 @@ # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # #############################################################################} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - //{$define DebugDisplay} // uncomment if u want to see the debug stuff {$define DebugFrames} {$define Info} @@ -18,6 +14,11 @@ unit UVideo; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + uses SDL, UGraphicClasses, textgl, -- cgit v1.2.3 From 84beb7412eaca48cbf5c9915b83e5f8c79c9a0e7 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:13:37 +0000 Subject: fixes to get working in lazarus.. compiling, linking, starting to run.. just fixing stuff :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@397 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 51 ++++++++++++++++++++++++++++++------------ Game/Code/Classes/UFiles.pas | 2 +- Game/Code/Classes/UTexture.pas | 5 ++--- 3 files changed, 40 insertions(+), 18 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index aa5fa18b..12a9a8dc 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -59,13 +59,31 @@ var implementation -uses UMain, Windows, SysUtils, UGraphic; +uses UMain, + Windows, + SysUtils, + {$IFDEF FPC} + LResources, + {$ENDIF} + UGraphic; procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont( aID : integer; aType, aResourceName : String); + var + Rejestr: TResourceStream; + begin + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); + try + Rejestr.Read(Fonts[ aID ].Width, 256); + finally + Rejestr.Free; + end; + end; + var font: HFONT; // Windows Font ID h_dc: hdc; - Rejestr: TResourceStream; Pet: integer; begin ActFont := 0; @@ -102,21 +120,21 @@ begin Fonts[4].Outline := 5;} - Rejestr := TResourceStream.Create(HInstance, 'Font', 'FNT'); - Rejestr.Read(Fonts[0].Width, 256); - Rejestr.Free; - Rejestr := TResourceStream.Create(HInstance, 'FontB', 'FNT'); - Rejestr.Read(Fonts[1].Width, 256); - Rejestr.Free; + {$IFDEF FPC} + loadfont( 0, 'DAT', 'eurostar_regular' ); + loadfont( 1, 'DAT', 'eurostar_regular_bold' ); + loadfont( 2, 'DAT', 'Outline 1' ); + loadfont( 3, 'DAT', 'Outline 2' ); + {$ELSE} + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'Font0' ); + loadfont( 3, 'FNT', 'FontO2' ); + {$ENDIF} + - Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Rejestr.Read(Fonts[2].Width, 256); - Rejestr.Free; - Rejestr := TResourceStream.Create(HInstance, 'FontO2', 'FNT'); - Rejestr.Read(Fonts[3].Width, 256); - Rejestr.Free; { Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); Rejestr.Read(Fonts[4].Width, 256); @@ -351,4 +369,9 @@ begin Fonts[ActFont].AspectW := Aspect; end; +initialization + {$I UltraStar.lrs} + end. + + diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index bbb22136..34342e26 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -113,7 +113,7 @@ begin //Required Information Song.Mp3 := ''; {$IFDEF FPC} - Song.BPM := NULL; + setlength( Song.BPM, 0 ); {$ELSE} Song.BPM := 0; {$ENDIF} diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 4eb00b4b..c1862828 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -21,11 +21,10 @@ uses OpenGL12, Math, Classes, SysUtils, - Graphics, - {$IFDEF FPC} - lazjpeg, + ulazjpeg, {$ELSE} + Graphics, JPEG, PNGImage, {$ENDIF} -- cgit v1.2.3 From 5e01f4ab6d0f3dd5ffa011b2a5638d5248e99f0f Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:26:58 +0000 Subject: trying to fix lazarus runtime errors.. also adding files to make sure everything required for lazarus compile, is in svn. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@399 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 2 ++ Game/Code/Classes/UTexture.pas | 8 ++++---- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 12a9a8dc..b61e2657 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -73,12 +73,14 @@ procedure BuildFont; // Build Our Bitmap Font var Rejestr: TResourceStream; begin + {$IFNDEF FPC} Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); try Rejestr.Read(Fonts[ aID ].Width, 256); finally Rejestr.Free; end; + {$ENDIF} end; var diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index c1862828..6895a250 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -870,10 +870,10 @@ begin Result.TexW := TexOrigW / TexNewW; Result.TexH := TexOrigH / TexNewH; - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; Result.Alpha := 1; // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these -- cgit v1.2.3 From a3904cbf6d498504bb0ab2510b50e6117d2869cc Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:38:24 +0000 Subject: added in the lots of debug logging... sorry guys. will remove it soon enough. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@400 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 4a18b8e2..d03ad8ed 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -217,6 +217,8 @@ begin //Just for Debugging //Comment for Release //LogAnalyze (Log2 + ': ' + Log1); + + LogError(Log2 + ': ' + Log1); end; procedure TLog.LogError(Log1, Log2: string); -- cgit v1.2.3 From 75279f0cdfb62b2fe3fb8043c40ed04a1ea594a7 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:40:13 +0000 Subject: oops... broke delphi building.. sorry guys. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@401 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index b61e2657..9700ce7a 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -371,8 +371,10 @@ begin Fonts[ActFont].AspectW := Aspect; end; +{$IFDEF FPC} initialization {$I UltraStar.lrs} +{$ENDIF} end. -- cgit v1.2.3 From 7ea4704bee262bd2dfd7c1eb240806e3911140cf Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:47:27 +0000 Subject: minor changes.. links to information on lazarus scanlines. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@402 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 6895a250..7f0b85c0 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -321,6 +321,10 @@ var begin {$IFNDEF FPC} // TODO : JB eeeew this is a nasty one... // but lazarus implementation scanlines is different :( + // need to implement as per + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 + // http://wiki.lazarus.freepascal.org/Developing_with_Graphics Log.BenchmarkStart(4); Mipmapping := true; @@ -344,36 +348,46 @@ begin if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin TextureB := TBitmap.Create; - if Format = 'BMP' then begin - if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Identifier); + if Format = 'BMP' then + begin + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); end - - else if Format = 'JPG' then begin + else + if Format = 'JPG' then + begin TextureJ := TJPEGImage.Create; - if FromRegistry then TextureJ.LoadFromStream(Res) - else begin + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin if FileExists(Identifier) then TextureJ.LoadFromFile(Identifier) else Exit; end; + TextureB.Assign(TextureJ); TextureJ.Free; end - else if Format = 'PNG' then begin {$IFNDEF FPC} // TODO : JB - fix this for lazarus.. TexturePNG := TPNGObject.Create; - if FromRegistry then TexturePNG.LoadFromStream(Res) - else begin + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin if FileExists(Identifier) then TexturePNG.LoadFromFile(Identifier) else Exit; end; + TextureB.Assign(TexturePNG); // transparent png hack start (part 1 of 2) if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then -- cgit v1.2.3 From 04d71cd12f8e2666d0077317b6316419f747c918 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:56:16 +0000 Subject: fix for delphi build... oops. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@403 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 9700ce7a..8a702ca7 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -131,7 +131,7 @@ begin {$ELSE} loadfont( 0, 'FNT', 'Font' ); loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'Font0' ); + loadfont( 2, 'FNT', 'FontO' ); loadfont( 3, 'FNT', 'FontO2' ); {$ENDIF} -- cgit v1.2.3 From db82b7e30a1b58b56fdb4bfc6089b47200ca1da1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 06:36:58 +0000 Subject: Ultrastar-DX now compiles in linux (using lazarus) Bass etc is commented out.. but it compiles, and im working through the runtime errors. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@408 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 769 ++++---- Game/Code/Classes/UCommon.pas | 230 ++- Game/Code/Classes/UCovers.pas | 494 +++--- Game/Code/Classes/UDLLManager.pas | 480 ++--- Game/Code/Classes/UDataBase.pas | 597 ++++--- Game/Code/Classes/UDraw.pas | 3145 +++++++++++++++++---------------- Game/Code/Classes/UGraphic.pas | 1218 ++++++------- Game/Code/Classes/UGraphicClasses.pas | 1345 +++++++------- Game/Code/Classes/UJoystick.pas | 555 +++--- Game/Code/Classes/ULanguage.pas | 470 ++--- Game/Code/Classes/ULight.pas | 311 ++-- Game/Code/Classes/ULog.pas | 496 +++--- Game/Code/Classes/UMain.pas | 1573 +++++++++-------- Game/Code/Classes/UMusic.pas | 1356 +++++++------- Game/Code/Classes/URecord.pas | 706 ++++---- Game/Code/Classes/UTexture.pas | 2071 +++++++++++----------- Game/Code/Classes/UTime.pas | 212 ++- 17 files changed, 8174 insertions(+), 7854 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 8a702ca7..ee1a74f3 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,381 +1,388 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses OpenGL12, - SDL, - UTexture, - Classes, - 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); - -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; - 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; - -implementation - -uses UMain, - Windows, - SysUtils, - {$IFDEF FPC} - LResources, - {$ENDIF} - UGraphic; - -procedure BuildFont; // Build Our Bitmap Font - - procedure loadfont( aID : integer; aType, aResourceName : String); - var - Rejestr: TResourceStream; - begin - {$IFNDEF FPC} - Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); - try - Rejestr.Read(Fonts[ aID ].Width, 256); - finally - Rejestr.Free; - end; - {$ENDIF} - end; - -var - font: HFONT; // Windows Font ID - h_dc: hdc; - Pet: integer; -begin - ActFont := 0; - - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); - Fonts[0].Tex.H := 30; - Fonts[0].AspectW := 0.9; - Fonts[0].Done := -1; - Fonts[0].Outline := 0; - - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Done := -1; - Fonts[1].Outline := 0; - - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Font Outline', 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Done := -1; - Fonts[2].Outline := 5; - - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - - - {$IFDEF FPC} - loadfont( 0, 'DAT', 'eurostar_regular' ); - loadfont( 1, 'DAT', 'eurostar_regular_bold' ); - loadfont( 2, 'DAT', 'Outline 1' ); - loadfont( 3, 'DAT', 'Outline 2' ); - {$ELSE} - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - {$ENDIF} - - - - -{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Rejestr.Read(Fonts[4].Width, 256); - Rejestr.Free;} - - for Pet := 0 to 255 do - Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; - - for Pet := 0 to 255 do - Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; - - for Pet := 0 to 255 do - Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; - -{ for Pet := 0 to 255 do - Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} - -end; - -procedure KillFont; // Delete The Font -begin -// glDeleteLists(base, 256); // Delete All 96 Characters -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; -begin -// Log.LogStatus(Text, 'glTextWidth'); - Result := 0; - while (length(text) > 0) do begin - Letter := Text[0]; - text := pchar(Copy(text, 2, Length(text)-1)); - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; // while -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; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter -begin - with Fonts[ActFont].Tex do begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; -// H := 30; - - // 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; - - // 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); - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); - glEnd; - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with -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; - -procedure glPrint(text: pchar); // Custom GL "Print" Routine -var - Letter: char; -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 -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; - -{$IFDEF FPC} -initialization - {$I UltraStar.lrs} -{$ENDIF} - -end. - - +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses OpenGL12, + SDL, + UTexture, + Classes, + 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); + +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; + 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; + +implementation + +uses UMain, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + lcltype, + {$ENDIF} + SysUtils, + {$IFDEF FPC} + LResources, + {$ENDIF} + UGraphic; + +procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont( aID : integer; aType, aResourceName : String); + var + Rejestr: TResourceStream; + begin + {$IFNDEF FPC} + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); + try + Rejestr.Read(Fonts[ aID ].Width, 256); + finally + Rejestr.Free; + end; + {$ENDIF} + end; + +var + font: HFONT; // Windows Font ID + h_dc: hdc; + Pet: integer; +begin + ActFont := 0; + + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Done := -1; + Fonts[0].Outline := 0; + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Done := -1; + Fonts[1].Outline := 0; + + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Font Outline', 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Done := -1; + Fonts[2].Outline := 5; + + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + + {$IFDEF FPC} + loadfont( 0, 'DAT', 'eurostar_regular' ); + loadfont( 1, 'DAT', 'eurostar_regular_bold' ); + loadfont( 2, 'DAT', 'Outline 1' ); + loadfont( 3, 'DAT', 'Outline 2' ); + {$ELSE} + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); + {$ENDIF} + + + + +{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[4].Width, 256); + Rejestr.Free;} + + for Pet := 0 to 255 do + Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; + + for Pet := 0 to 255 do + Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; + + for Pet := 0 to 255 do + Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; + +{ for Pet := 0 to 255 do + Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + while (length(text) > 0) do begin + Letter := Text[0]; + text := pchar(Copy(text, 2, Length(text)-1)); + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; // while +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; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; +// H := 30; + + // 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; + + // 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); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + glEnd; + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +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; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +var + Letter: char; +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 +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; + +{$IFDEF FPC} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + +end. + + diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index f25e025b..b7ddd7ba 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,98 +1,132 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses - windows; - -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(Wnd: HWND); - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; -{$ENDIF} - -implementation - -{$IFDEF FPC} - -function MaxValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result < Data[I] then - Result := Data[I]; -end; - -function MinValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result > Data[I] then - Result := Data[I]; -end; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin -RandomRange := Random(aMax-aMin) + aMin ; -end; - - - -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin -(* - UtilWindowClass.hInstance := HInstance; -{$IFDEF PIC} - UtilWindowClass.lpfnWndProc := @DefWindowProc; -{$ENDIF} - ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); - if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then - begin - if ClassRegistered then - Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); - Windows.RegisterClass(UtilWindowClass); - end; - Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil); -*) - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil); - -(* - if Assigned(Method) then - SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); -*) -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); - -// if Instance <> @DefWindowProc then -// FreeObjectInstance(Instance); -end; - -{$ENDIF} - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +//function AllocateHWnd(Method: TWndMethod): HWND; +//procedure DeallocateHWnd(Wnd: HWND); + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; +{$ENDIF} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +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} + + +{$IFDEF FPC} + +function MaxValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result < Data[I] then + Result := Data[I]; +end; + +function MinValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result > Data[I] then + Result := Data[I]; +end; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin +RandomRange := Random(aMax-aMin) + aMin ; +end; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{ +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +} + +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index efed1435..094fe43c 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -1,246 +1,248 @@ -unit UCovers; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses OpenGL12, - Windows, - Math, - Classes, - SysUtils, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - UThemes, - UTexture; - -type - TCover = record - Name: string; - W: word; - H: word; - Size: integer; - Position: integer; // position of picture in the cache file -// Data: array of byte; - end; - - TCovers = class - Cover: array of TCover; - W: word; - H: word; - Size: integer; - Data: array of byte; - WritetoFile: Boolean; - - constructor Create; - procedure Load; - procedure Save; - procedure AddCover(Name: string); - function CoverExists(Name: string): boolean; - function CoverNumber(Name: string): integer; - procedure PrepareData(Name: string); - end; - -var - Covers: TCovers; - -implementation - -uses UMain, - // UFiles, - ULog, - DateUtils; - -constructor TCovers.Create; -begin - W := 128; - H := 128; - Size := W*H*3; - Load; - WritetoFile := True; -end; - -procedure TCovers.Load; -var - F: File; - C: integer; // cover number - W: word; - H: word; - Bits: byte; - NLen: word; - Name: string; -// Data: array of byte; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); - - SetLength(Cover, 0); - - while not EOF(F) do - begin - SetLength(Cover, Length(Cover)+1); - - BlockRead(F, W, 2); - Cover[High(Cover)].W := W; - - BlockRead(F, H, 2); - Cover[High(Cover)].H := H; - - BlockRead(F, Bits, 1); - - Cover[High(Cover)].Size := W * H * (Bits div 8); - - // test - // W := 128; - // H := 128; - // Bits := 24; - // Seek(F, FilePos(F) + 3); - - BlockRead(F, NLen, 2); - SetLength(Name, NLen); - - BlockRead(F, Name[1], NLen); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].Position := FilePos(F); - Seek(F, FilePos(F) + W*H*(Bits div 8)); - - // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); - // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); - - end; // While - - CloseFile(F); - end; // fileexists -end; - -procedure TCovers.Save; -var - F: File; - C: integer; // cover number - W: word; - H: word; - NLen: word; - Bits: byte; -begin -{ AssignFile(F, GamePath + 'covers.cache'); - Rewrite(F, 1); - - Bits := 24; - for C := 0 to High(Cover) do begin - W := Cover[C].W; - H := Cover[C].H; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Cover[C].Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Cover[C].Name[1], NLen); - BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); - end; - - CloseFile(F);} -end; - -procedure TCovers.AddCover(Name: string); -var - B: integer; - F: File; - C: integer; // cover number - NLen: word; - Bits: byte; -begin - if not CoverExists(Name) then begin - SetLength(Cover, Length(Cover)+1); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].W := W; - Cover[High(Cover)].H := H; - Cover[High(Cover)].Size := Size; - - // do not copy data. write them directly to file -// SetLength(Cover[High(Cover)].Data, Size); -// for B := 0 to Size-1 do -// Cover[High(Cover)].Data[B] := CacheMipmap[B]; - - if WritetoFile then - begin - AssignFile(F, GamePath + 'covers.cache'); - if FileExists(GamePath + 'covers.cache') then begin - Reset(F, 1); - Seek(F, FileSize(F)); - end else - Rewrite(F, 1); - - Bits := 24; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Name[1], NLen); - - Cover[High(Cover)].Position := FilePos(F); - BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); - - CloseFile(F); - end; - end - else - Cover[High(Cover)].Position := 0; -end; - -function TCovers.CoverExists(Name: string): boolean; -var - C: integer; // cover -begin - Result := false; - C := 0; - while (C <= High(Cover)) and (Result = false) do begin - if Cover[C].Name = Name then Result := true; - Inc(C); - end; -end; - -function TCovers.CoverNumber(Name: string): integer; -var - C: integer; -begin - Result := -1; - C := 0; - while (C <= High(Cover)) and (Result = -1) do begin - if Cover[C].Name = Name then Result := C; - Inc(C); - end; -end; - -procedure TCovers.PrepareData(Name: string); -var - F: File; - C: integer; -begin - if FileExists(GamePath + 'covers.cache') then begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - C := CoverNumber(Name); - SetLength(Data, Cover[C].Size); - if Length(Data) < 6 then beep; - Seek(F, Cover[C].Position); - BlockRead(F, Data[0], Cover[C].Size); - CloseFile(F); - end; -end; - -end. +unit UCovers; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation + +uses UMain, + // UFiles, + ULog, + DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; // While + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + if FileExists(GamePath + 'covers.cache') then begin + Reset(F, 1); + Seek(F, FileSize(F)); + end else + Rewrite(F, 1); + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + while (C <= High(Cover)) and (Result = false) do begin + if Cover[C].Name = Name then Result := true; + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + while (C <= High(Cover)) and (Result = -1) do begin + if Cover[C].Name = Name then Result := C; + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 0d328c37..d25efb35 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -1,233 +1,247 @@ -unit UDLLManager; - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -interface - -uses ModiSDK, - UFiles; - -type - TDLLMan = class - private - hLib: THandle; - P_Init: fModi_Init; - P_Draw: fModi_Draw; - P_Finish: fModi_Finish; - P_RData: pModi_RData; - public - Plugins: array of TPluginInfo; - PluginPaths: array of String; - Selected: ^TPluginInfo; - - constructor Create; - - procedure GetPluginList; - procedure ClearPluginInfo(No: Cardinal); - function LoadPluginInfo(Filename: String; No: Cardinal): boolean; - - function LoadPlugin(No: Cardinal): boolean; - procedure UnLoadPlugin; - - function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; - function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; - function PluginFinish (var Playerinfo: TPlayerinfo): byte; - procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); - end; - -var - DLLMan: TDLLMan; - -const DLLPath = 'Plugins\'; - -implementation -uses Windows, ULog, SysUtils; - - -constructor TDLLMan.Create; -begin - SetLength(Plugins, 0); - SetLength(PluginPaths, Length(Plugins)); - GetPluginList; -end; - -procedure TDLLMan.GetPluginList; -var - SR: TSearchRec; -begin - - if FindFirst(DLLPath + '*.dll', faAnyFile , SR) = 0 then - begin - repeat - SetLength(Plugins, Length(Plugins)+1); - SetLength(PluginPaths, Length(Plugins)); - - if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful - begin - PluginPaths[High(PluginPaths)] := SR.Name; - end - else //Error Loading - begin - SetLength(Plugins, Length(Plugins)-1); - SetLength(PluginPaths, Length(Plugins)); - end; - - until FindNext(SR) <> 0; - FindClose(SR); - end; -end; - -procedure TDLLMan.ClearPluginInfo(No: Cardinal); -begin - //Set to Party Modi Plugin - Plugins[No].Typ := 8; - - Plugins[No].Name := 'unknown'; - Plugins[No].NumPlayers := 0; - - Plugins[No].Creator := 'Nobody'; - Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; - - Plugins[No].LoadSong := True; - Plugins[No].ShowScore := True; - Plugins[No].ShowBars := False; - Plugins[No].ShowNotes := True; - Plugins[No].LoadVideo := True; - Plugins[No].LoadBack := True; - - Plugins[No].TeamModeOnly := False; - Plugins[No].GetSoundData := False; - Plugins[No].Dummy := False; - - - Plugins[No].BGShowFull := False; - Plugins[No].BGShowFull_O := True; - - Plugins[No].ShowRateBar:= False; - Plugins[No].ShowRateBar_O := True; - - Plugins[No].EnLineBonus := False; - Plugins[No].EnLineBonus_O := True; -end; - -function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; -var - hLibg: THandle; - Info: pModi_PluginInfo; - I: Integer; -begin - Result := False; - //Clear Plugin Info - ClearPluginInfo(No); - - {//Workaround Plugins Loaded 2 Times - For I := low(PluginPaths) to high(PluginPaths) do - if (PluginPaths[I] = Filename) then - exit; } - - //Load Libary - hLibg := LoadLibrary(PChar(DLLPath + Filename)); - //If Loaded - if (hLibg <> 0) then - begin - //Load Info Procedure - @Info := GetProcAddress (hLibg, PChar('PluginInfo')); - - //If Loaded - if (@Info <> nil) then - begin - //Load PluginInfo - Info (Plugins[No]); - Result := True; - end - else - Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); - - FreeLibrary (hLibg); - end - else - Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); -end; - -function TDLLMan.LoadPlugin(No: Cardinal): boolean; -begin - Result := False; - //Load Libary - hLib := LoadLibrary(PChar(DLLPath + PluginPaths[No])); - //If Loaded - if (hLib <> 0) then - begin - //Load Info Procedure - @P_Init := GetProcAddress (hLib, PChar('Init')); - @P_Draw := GetProcAddress (hLib, PChar('Draw')); - @P_Finish := GetProcAddress (hLib, PChar('Finish')); - - //If Loaded - if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then - begin - Selected := @Plugins[No]; - Result := True; - end - else - begin - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); - - end; - end - else - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); -end; - -procedure TDLLMan.UnLoadPlugin; -begin -if (hLib <> 0) then - FreeLibrary (hLib); - -//Selected := nil; -@P_Init := nil; -@P_Draw := nil; -@P_Finish := nil; -@P_RData := nil; -end; - -function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; -var - Methods: TMethodRec; -begin - Methods.LoadTex := LoadTex; - Methods.Print := Print; - Methods.LoadSound := LoadSound; - Methods.PlaySound := PlaySound; - - if (@P_Init <> nil) then - Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) - else - Result := False -end; - -function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; -begin -if (@P_Draw <> nil) then - Result := P_Draw (PlayerInfo, CurSentence) -else - Result := False -end; - -function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; -begin -if (@P_Finish <> nil) then - Result := P_Finish (PlayerInfo) -else - Result := 0; -end; - -procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); -begin -if (@P_RData <> nil) then - P_RData (handle, buffer, len, user); -end; - -end. +unit UDLLManager; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +interface + +uses ModiSDK, + UFiles; + +type + TDLLMan = class + private + hLib: THandle; + P_Init: fModi_Init; + P_Draw: fModi_Draw; + P_Finish: fModi_Finish; + P_RData: pModi_RData; + public + Plugins: array of TPluginInfo; + PluginPaths: array of String; + Selected: ^TPluginInfo; + + constructor Create; + + procedure GetPluginList; + procedure ClearPluginInfo(No: Cardinal); + function LoadPluginInfo(Filename: String; No: Cardinal): boolean; + + function LoadPlugin(No: Cardinal): boolean; + procedure UnLoadPlugin; + + function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; + function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; + function PluginFinish (var Playerinfo: TPlayerinfo): byte; + procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); + end; + +var + DLLMan: TDLLMan; + +const + {$IFDEF win32} + DLLPath = 'Plugins\'; + DLLExt = '.dll'; + {$ELSE} + DLLPath = 'Plugins/'; + DLLExt = '.so'; + {$ENDIF} + +implementation + +uses {$IFDEF win32} + windows, + {$ELSE} + dynlibs, + {$ENDIF} + ULog, + SysUtils; + + +constructor TDLLMan.Create; +begin + SetLength(Plugins, 0); + SetLength(PluginPaths, Length(Plugins)); + GetPluginList; +end; + +procedure TDLLMan.GetPluginList; +var + SR: TSearchRec; +begin + + if FindFirst(DLLPath + '*' + DLLExt, faAnyFile , SR) = 0 then + begin + repeat + SetLength(Plugins, Length(Plugins)+1); + SetLength(PluginPaths, Length(Plugins)); + + if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful + begin + PluginPaths[High(PluginPaths)] := SR.Name; + end + else //Error Loading + begin + SetLength(Plugins, Length(Plugins)-1); + SetLength(PluginPaths, Length(Plugins)); + end; + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +procedure TDLLMan.ClearPluginInfo(No: Cardinal); +begin + //Set to Party Modi Plugin + Plugins[No].Typ := 8; + + Plugins[No].Name := 'unknown'; + Plugins[No].NumPlayers := 0; + + Plugins[No].Creator := 'Nobody'; + Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; + + Plugins[No].LoadSong := True; + Plugins[No].ShowScore := True; + Plugins[No].ShowBars := False; + Plugins[No].ShowNotes := True; + Plugins[No].LoadVideo := True; + Plugins[No].LoadBack := True; + + Plugins[No].TeamModeOnly := False; + Plugins[No].GetSoundData := False; + Plugins[No].Dummy := False; + + + Plugins[No].BGShowFull := False; + Plugins[No].BGShowFull_O := True; + + Plugins[No].ShowRateBar:= False; + Plugins[No].ShowRateBar_O := True; + + Plugins[No].EnLineBonus := False; + Plugins[No].EnLineBonus_O := True; +end; + +function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; +var + hLibg: THandle; + Info: pModi_PluginInfo; + I: Integer; +begin + Result := False; + //Clear Plugin Info + ClearPluginInfo(No); + + {//Workaround Plugins Loaded 2 Times + For I := low(PluginPaths) to high(PluginPaths) do + if (PluginPaths[I] = Filename) then + exit; } + + //Load Libary + hLibg := LoadLibrary(PChar(DLLPath + Filename)); + //If Loaded + if (hLibg <> 0) then + begin + //Load Info Procedure + @Info := GetProcAddress (hLibg, PChar('PluginInfo')); + + //If Loaded + if (@Info <> nil) then + begin + //Load PluginInfo + Info (Plugins[No]); + Result := True; + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); + + FreeLibrary (hLibg); + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); +end; + +function TDLLMan.LoadPlugin(No: Cardinal): boolean; +begin + Result := False; + //Load Libary + hLib := LoadLibrary(PChar(DLLPath + PluginPaths[No])); + //If Loaded + if (hLib <> 0) then + begin + //Load Info Procedure + @P_Init := GetProcAddress (hLib, PChar('Init')); + @P_Draw := GetProcAddress (hLib, PChar('Draw')); + @P_Finish := GetProcAddress (hLib, PChar('Finish')); + + //If Loaded + if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then + begin + Selected := @Plugins[No]; + Result := True; + end + else + begin + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); + + end; + end + else + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); +end; + +procedure TDLLMan.UnLoadPlugin; +begin +if (hLib <> 0) then + FreeLibrary (hLib); + +//Selected := nil; +@P_Init := nil; +@P_Draw := nil; +@P_Finish := nil; +@P_RData := nil; +end; + +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; +var + Methods: TMethodRec; +begin + Methods.LoadTex := LoadTex; + Methods.Print := Print; + Methods.LoadSound := LoadSound; + Methods.PlaySound := PlaySound; + + if (@P_Init <> nil) then + Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) + else + Result := False +end; + +function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; +begin +if (@P_Draw <> nil) then + Result := P_Draw (PlayerInfo, CurSentence) +else + Result := False +end; + +function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; +begin +if (@P_Finish <> nil) then + Result := P_Finish (PlayerInfo) +else + Result := 0; +end; + +procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); +begin +if (@P_RData <> nil) then + P_RData (handle, buffer, len, user); +end; + +end. diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index 009d0d63..deee85c0 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -1,299 +1,298 @@ -unit UDataBase; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -uses USongs, SQLiteTable3; - -//-------------------- -//DataBaseSystem - Class including all DB Methods -//-------------------- -type - TStatResult = record - Case Typ: Byte of - 0: (Singer: ShortString; - Score: Word; - Difficulty: Byte; - SongArtist: ShortString; - SongTitle: ShortString); - - 1: (Player: ShortString; - AverageScore: Word); - - 2: (Artist: ShortString; - Title: ShortString; - TimesSung: Word); - - 3: (ArtistName: ShortString; - TimesSungtot: Word); - end; - AStatResult = Array of TStatResult; - - TDataBaseSystem = class - private - ScoreDB: TSqliteDatabase; - sFilename: string; - public - - - property Filename: String read sFilename; - - Destructor Free; - - Procedure Init(const Filename: string); - procedure ReadScore(var Song: TSong); - procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); - procedure WriteScore(var Song: TSong); - - Function GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; - Function GetTotalEntrys(const Typ: Byte): Cardinal; - end; - -var - DataBase: TDataBaseSystem; - -implementation - -uses IniFiles, SysUtils; - -//-------------------- -//Create - Opens Database and Create Tables if not Exist -//-------------------- - -Procedure TDataBaseSystem.Init(const Filename: string); -begin - //Open Database - ScoreDB := TSqliteDatabase.Create(Filename); - sFilename := Filename; - - try - //Look for Tables => When not exist Create them - if not ScoreDB.TableExists('US_Scores') then - ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); - - if not ScoreDB.TableExists('US_Songs') then - ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); - //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper - {if not ScoreDB.TableExists('US_SongCache') then - ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} - - - finally - //ScoreDB.Free; - end; - -end; - -//-------------------- -//Free - Frees Database -//-------------------- -Destructor TDataBaseSystem.Free; -begin - ScoreDB.Free; -end; - -//-------------------- -//ReadScore - Read Scores into SongArray -//-------------------- -procedure TDataBaseSystem.ReadScore(var Song: TSong); -var - TableData: TSqliteTable; - Dif: Byte; -begin - //ScoreDB := TSqliteDatabase.Create(sFilename); - try - try - //Search Song in DB - TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); - //Empty Old Scores - SetLength (Song.Score[0], 0); - SetLength (Song.Score[1], 0); - SetLength (Song.Score[2], 0); - - while not TableData.Eof do//Go through all Entrys - begin//Add one Entry to Array - Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); - if (Dif>=0) AND (Dif<=2) then - begin - SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); - - Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); - Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); - end; - TableData.Next; - end; - - except //Im Fehlerfall - for Dif := 0 to 2 do - begin - SetLength(Song.Score[Dif], 1); - Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; - end; - end; - finally - //ScoreDb.Free; - end; -end; - -//-------------------- -//AddScore - Add one new Score to DB -//-------------------- -procedure TDataBaseSystem.AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); -var -ID: Integer; -TableData: TSqliteTable; -begin - //ScoreDB := TSqliteDatabase.Create(sFilename); - try - //Prevent 0 Scores from being added - if (Score > 0) then - begin - - ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); - if ID = 0 then //Song doesn't exist -> Create - begin - ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); - ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); - if ID = 0 then //Could not Create Table - exit; - end; - //Create new Entry - ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); - - //Delete Last Position when there are more than 5 Entrys - if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then - begin - TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); - ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); - end; - - end; - finally - //ScoreDB.Free; - end; -end; - -//-------------------- -//WriteScore - Not needed with new System; But used for Increment Played Count -//-------------------- -procedure TDataBaseSystem.WriteScore(var Song: TSong); -begin - try - //Increase TimesPlayed - ScoreDB.ExecSQL ('UPDATE `us_songs` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); - except - - end; -end; - -//-------------------- -//GetStats - Write some Stats to Array, Returns True if Chossen Page has Entrys -//Case Typ of -//0 - Best Scores -//1 - Best Singers -//2 - Most sung Songs -//3 - Most popular Band -//-------------------- -Function TDataBaseSystem.GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; -var - Query: String; - TableData: TSqliteTable; -begin - Result := False; - - if (Length(Stats) < Count) then - Exit; - - {Todo: - Add Prevention that only Players with more than 5 Scores are Selected at Typ 2} - - //Create Query - Case Typ of - 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `US_Scores` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; - 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; - 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `US_Songs` ORDER BY `TimesPlayed`'; - 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `US_Songs` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; - end; - - //Add Order Direction - If Reversed then - Query := Query + ' ASC' - else - Query := Query + ' DESC'; - - //Add Limit - Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; - - //Execute Query - //try - TableData := ScoreDB.GetTable(Query); - {except - exit; - end;} - - //if Result empty -> Exit - if (TableData.RowCount < 1) then - exit; - - //Copy Result to Stats Array - while not TableData.Eof do - begin - Stats[TableData.Row].Typ := Typ; - - Case Typ of - 0:begin - Stats[TableData.Row].Singer := TableData.Fields[0]; - - Stats[TableData.Row].Difficulty := StrtoIntDef(TableData.Fields[1], 0); - - Stats[TableData.Row].Score := StrtoIntDef(TableData.Fields[2], 0){TableData.FieldAsInteger(2)}; - Stats[TableData.Row].SongArtist := TableData.Fields[3]; - Stats[TableData.Row].SongTitle := TableData.Fields[4]; - end; - - 1:begin - Stats[TableData.Row].Player := TableData.Fields[0]; - Stats[TableData.Row].AverageScore := StrtoIntDef(TableData.Fields[1], 0); - end; - - 2:begin - Stats[TableData.Row].Artist := TableData.Fields[0]; - Stats[TableData.Row].Title := TableData.Fields[1]; - Stats[TableData.Row].TimesSung := StrtoIntDef(TableData.Fields[2], 0); - end; - - 3:begin - Stats[TableData.Row].ArtistName := TableData.Fields[0]; - Stats[TableData.Row].TimesSungtot := StrtoIntDef(TableData.Fields[1], 0); - end; - - end; - - TableData.Next; - end; - - Result := True; -end; - -//-------------------- -//GetTotalEntrys - Get Total Num of entrys for a Stats Query -//-------------------- -Function TDataBaseSystem.GetTotalEntrys(const Typ: Byte): Cardinal; -var Query: String; -begin - //Create Query - Case Typ of - 0: Query := 'SELECT COUNT(`SongID`) FROM `US_Scores`;'; - 1: Query := 'SELECT COUNT(DISTINCT `Player`) FROM `US_Scores`;'; - 2: Query := 'SELECT COUNT(`ID`) FROM `US_Songs`;'; - 3: Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `US_Songs`;'; - end; - - Result := ScoreDB.GetTableValue(Query); -end; - -end. +unit UDataBase; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +uses USongs, SQLiteTable3; + +//-------------------- +//DataBaseSystem - Class including all DB Methods +//-------------------- +type + TStatResult = record + Case Typ: Byte of + 0: (Singer: ShortString; + Score: Word; + Difficulty: Byte; + SongArtist: ShortString; + SongTitle: ShortString); + + 1: (Player: ShortString; + AverageScore: Word); + + 2: (Artist: ShortString; + Title: ShortString; + TimesSung: Word); + + 3: (ArtistName: ShortString; + TimesSungtot: Word); + end; + AStatResult = Array of TStatResult; + + TDataBaseSystem = class + private + ScoreDB: TSqliteDatabase; + sFilename: string; + public + + + property Filename: String read sFilename; + + Destructor Free; + + Procedure Init(const Filename: string); + procedure ReadScore(var Song: TSong); + procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); + procedure WriteScore(var Song: TSong); + + Function GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; + Function GetTotalEntrys(const Typ: Byte): Cardinal; + end; + +var + DataBase: TDataBaseSystem; + +implementation + +uses IniFiles, SysUtils; + +//-------------------- +//Create - Opens Database and Create Tables if not Exist +//-------------------- + +Procedure TDataBaseSystem.Init(const Filename: string); +begin + //Open Database + ScoreDB := TSqliteDatabase.Create(Filename); + sFilename := Filename; + + try + //Look for Tables => When not exist Create them + if not ScoreDB.TableExists('US_Scores') then + ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + + if not ScoreDB.TableExists('US_Songs') then + ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); + //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper + {if not ScoreDB.TableExists('US_SongCache') then + ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} + + + finally + //ScoreDB.Free; + end; + +end; + +//-------------------- +//Free - Frees Database +//-------------------- +Destructor TDataBaseSystem.Free; +begin + ScoreDB.Free; +end; + +//-------------------- +//ReadScore - Read Scores into SongArray +//-------------------- +procedure TDataBaseSystem.ReadScore(var Song: TSong); +var + TableData: TSqliteTable; + Dif: Byte; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + try + //Search Song in DB + TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); + //Empty Old Scores + SetLength (Song.Score[0], 0); + SetLength (Song.Score[1], 0); + SetLength (Song.Score[2], 0); + + while not TableData.Eof do//Go through all Entrys + begin//Add one Entry to Array + Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); + if (Dif>=0) AND (Dif<=2) then + begin + SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); + + Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); + Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + end; + TableData.Next; + end; + + except //Im Fehlerfall + for Dif := 0 to 2 do + begin + SetLength(Song.Score[Dif], 1); + Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; + end; + end; + finally + //ScoreDb.Free; + end; +end; + +//-------------------- +//AddScore - Add one new Score to DB +//-------------------- +procedure TDataBaseSystem.AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); +var +ID: Integer; +TableData: TSqliteTable; +begin + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + //Prevent 0 Scores from being added + if (Score > 0) then + begin + + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Song doesn't exist -> Create + begin + ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Could not Create Table + exit; + end; + //Create new Entry + ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); + + //Delete Last Position when there are more than 5 Entrys + if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then + begin + TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); + ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); + end; + + end; + finally + //ScoreDB.Free; + end; +end; + +//-------------------- +//WriteScore - Not needed with new System; But used for Increment Played Count +//-------------------- +procedure TDataBaseSystem.WriteScore(var Song: TSong); +begin + try + //Increase TimesPlayed + ScoreDB.ExecSQL ('UPDATE `us_songs` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); + except + + end; +end; + +//-------------------- +//GetStats - Write some Stats to Array, Returns True if Chossen Page has Entrys +//Case Typ of +//0 - Best Scores +//1 - Best Singers +//2 - Most sung Songs +//3 - Most popular Band +//-------------------- +Function TDataBaseSystem.GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; +var + Query: String; + TableData: TSqliteTable; +begin + Result := False; + + if (Length(Stats) < Count) then + Exit; + + {Todo: Add Prevention that only Players with more than 5 Scores are Selected at Typ 2} + + //Create Query + Case Typ of + 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `US_Scores` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; + 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; + 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `US_Songs` ORDER BY `TimesPlayed`'; + 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `US_Songs` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; + end; + + //Add Order Direction + If Reversed then + Query := Query + ' ASC' + else + Query := Query + ' DESC'; + + //Add Limit + Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; + + //Execute Query + //try + TableData := ScoreDB.GetTable(Query); + {except + exit; + end;} + + //if Result empty -> Exit + if (TableData.RowCount < 1) then + exit; + + //Copy Result to Stats Array + while not TableData.Eof do + begin + Stats[TableData.Row].Typ := Typ; + + Case Typ of + 0:begin + Stats[TableData.Row].Singer := TableData.Fields[0]; + + Stats[TableData.Row].Difficulty := StrtoIntDef(TableData.Fields[1], 0); + + Stats[TableData.Row].Score := StrtoIntDef(TableData.Fields[2], 0){TableData.FieldAsInteger(2)}; + Stats[TableData.Row].SongArtist := TableData.Fields[3]; + Stats[TableData.Row].SongTitle := TableData.Fields[4]; + end; + + 1:begin + Stats[TableData.Row].Player := TableData.Fields[0]; + Stats[TableData.Row].AverageScore := StrtoIntDef(TableData.Fields[1], 0); + end; + + 2:begin + Stats[TableData.Row].Artist := TableData.Fields[0]; + Stats[TableData.Row].Title := TableData.Fields[1]; + Stats[TableData.Row].TimesSung := StrtoIntDef(TableData.Fields[2], 0); + end; + + 3:begin + Stats[TableData.Row].ArtistName := TableData.Fields[0]; + Stats[TableData.Row].TimesSungtot := StrtoIntDef(TableData.Fields[1], 0); + end; + + end; + + TableData.Next; + end; + + Result := True; +end; + +//-------------------- +//GetTotalEntrys - Get Total Num of entrys for a Stats Query +//-------------------- +Function TDataBaseSystem.GetTotalEntrys(const Typ: Byte): Cardinal; +var Query: String; +begin + //Create Query + Case Typ of + 0: Query := 'SELECT COUNT(`SongID`) FROM `US_Scores`;'; + 1: Query := 'SELECT COUNT(DISTINCT `Player`) FROM `US_Scores`;'; + 2: Query := 'SELECT COUNT(`ID`) FROM `US_Songs`;'; + 3: Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `US_Songs`;'; + end; + + Result := ScoreDB.GetTableValue(Query); +end; + +end. diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index a28f1efc..ef1f2709 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,1562 +1,1583 @@ -unit UDraw; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -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; NrCzesci: integer); -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); - -// TimeBar -procedure SingDrawTimeBar(); - -// The Singbar -procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); - -//Phrasen Bonus - Line Bonus -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); - -//Draw Editor NoteLines -procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 Windows, OpenGL12, 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 >= 1 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 - Pet: integer; -begin; -// Log.LogStatus('Oscilloscope', 'SingDraw'); - glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - - glBegin(GL_LINE_STRIP); - glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); - for Pet := 2 to Sound[NrSound].n div 1 do begin - glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), - -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); - end; - glEnd; -end; - -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -var - Pet: integer; -begin - glEnable(GL_BLEND); - glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); - glBegin(GL_LINES); - for Pet := 0 to 9 do begin - glVertex2f(Left, Top + Pet * Space); - glVertex2f(Right, Top + Pet * Space); - end; - glEnd; - glDisable(GL_BLEND); -end; - -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); -var - Pet: integer; - TempR: real; -begin - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - glEnable(GL_BLEND); - glBegin(GL_LINES); - for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin - if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then - glColor4f(0, 0, 0, 1) - else - glColor4f(0, 0, 0, 0.3); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); - end; - glEnd; - glDisable(GL_BLEND); -end; - -// draw blank Notebars -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: integer; - TempR: real; - R,G,B: real; - - PlayerNumber: Integer; - - GoldenStarPos : real; -begin -// We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero -// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 - NrCzesci := 0; - -// exploit done - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - - - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case Wartosc of - 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - 2: 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 == ende, schluss - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge - - 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -var - TempR: real; - Rec: TRecR; - N: integer; - R: real; - G: real; - B: real; - 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].IlNut > 0 then - begin - TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); - for N := 0 to Player[NrGracza].HighNut do - begin - with Player[NrGracza].Nuta[N] do - begin - // Left part of note - Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; - - // draw the left part - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; - - // (nowe) - dunno - if (Start+Dlugosc-1 = Czas.AktBeatD) then - Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); - if not (Start+Dlugosc-1 = Czas.AktBeatD) then - - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - end; - end; // with - end; // for - // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit - // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ - - // passing on NrGracza... hope this is really something like the player-number, not only - // some kind of weird index into a colour-table - - if (Ini.EffectSing=1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); - end; // if -end; - -//draw Note glow -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); -var - Rec: TRecR; - Pet: integer; - TempR: real; - R,G,B: real; - X1, X2, X3, X4: real; - W, H: real; -begin - if (Player[NrGracza].ScoreTotalI >= 0) then begin - glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - // begin: 14, 20 - // easy: 6, 11 - W := NotesW * 2 + 2; - H := NotesH * 1.5 + 3.5; - - X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie - X1 := X2-W; - - X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie - X4 := X3+W; - - // left - Rec.Left := X1; - Rec.Right := X2; - Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; - Rec.Bottom := Rec.Top + 2 * H; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 - Pet: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; - NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - LyricTemp: string; - PetCz: integer; - - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - -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 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; - - // rysuje tekst - new Lyric engine - ScreenSing.LyricMain.Draw; - ScreenSing.LyricSub.Draw; - - // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * -// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 - - //SingBar Mod - //modded again to make it moveable: it's working, so why try harder - else if Ini.Oscilloscope = 2 then begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; - end; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - if Ini.LineBonus > 0 then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // shift position of the pop up (if not dead) - end; // loop - for all players - end; // if - linebonus - - - if PlayersPlay = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; - end; - //PhrasenBonus - Line Bonus Mod 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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes - end; - - if (PlayersPlay = 2) then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(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; - - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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 - Pet: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; - NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - LyricTemp: string; - PetCz: integer; - - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - -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; - - // Lyric engine - ScreenSingModi.LyricMain.Draw; - ScreenSingModi.LyricSub.Draw; - - // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 - - //SingBar Mod - // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores - else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; - end; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // pop up still visible, has not reached it's position - move it - end; // loop through all players - end; // if it's time to draw them - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; - end; -//PhrasenBonus - Line Bonus Mod 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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); - end; - - if (PlayersPlay = 2) then begin - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - end; - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - end; - - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - end; - - if PlayerInfo.Playerinfo[2].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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: -// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - - // Golden Note Patch - case Wartosc of - 0: glColor4f(1, 1, 1, 0.35); - 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 0.3, 0.85); - end; // case - - - - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; -begin - x := Theme.Sing.StaticTimeProgress.x; - y := Theme.Sing.StaticTimeProgress.y; - width:= Theme.Sing.StaticTimeProgress.w; - height:= Theme.Sing.StaticTimeProgress.h; - - glColor4f(Theme.Sing.StaticTimeProgress.ColR, - Theme.Sing.StaticTimeProgress.ColG, - Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - - glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(x,y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); - glTexCoord2f(0, 1); glVertex2f(x, y+height); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1,1,1,1); -end; - -end. - +unit UDraw; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +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; NrCzesci: integer); +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +// The Singbar +procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); + +//Phrasen Bonus - Line Bonus +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); + +//Draw Editor NoteLines +procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGL12, + 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 >= 1 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 + Pet: integer; +begin; +// Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } + + glBegin(GL_LINE_STRIP); + glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + for Pet := 2 to Sound[NrSound].n div 1 do begin + glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), + -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + end; + glEnd; +end; + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Pet: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Pet := 0 to 9 do begin + glVertex2f(Left, Top + Pet * Space); + glVertex2f(Right, Top + Pet * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +var + Pet: integer; + TempR: real; +begin + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin + if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + + PlayerNumber: Integer; + + GoldenStarPos : real; +begin +// We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero +// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 + NrCzesci := 0; + +// exploit done + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case Wartosc of + 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + 2: 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 == ende, schluss + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge + + 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R: real; + G: real; + B: real; + 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].IlNut > 0 then + begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do + begin + with Player[NrGracza].Nuta[N] do + begin + // Left part of note + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; // with + end; // for + // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit + // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + + // passing on NrGracza... hope this is really something like the player-number, not only + // some kind of weird index into a colour-table + + if (Ini.EffectSing=1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; +begin + if (Player[NrGracza].ScoreTotalI >= 0) then begin + glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + +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 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; + + // rysuje tekst - new Lyric engine + ScreenSing.LyricMain.Draw; + ScreenSing.LyricSub.Draw; + + // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 + + //SingBar Mod + //modded again to make it moveable: it's working, so why try harder + else if Ini.Oscilloscope = 2 then + begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + + if PlayersPlay = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); + end; + + if PlayersPlay = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + + if PlayersPlay = 3 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if Ini.LineBonus > 0 then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + if Player[E].LineBonus_Alpha <= 0 then + begin + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False + end + else + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + + end; // shift position of the pop up (if not dead) + end; // loop - for all players + end; // if - linebonus + + + if PlayersPlay = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + end + + else if PlayersPlay = 2 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end + + else if PlayersPlay = 3 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end + + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); + end; + end; + end; + //PhrasenBonus - Line Bonus Mod 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(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; + + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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 + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + +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; + + // Lyric engine + ScreenSingModi.LyricMain.Draw; + ScreenSingModi.LyricSub.Draw; + + // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 + + //SingBar Mod + // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores + else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); + end; + + if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + + if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + + if Player[E].LineBonus_Alpha <= 0 then + begin + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False + end + else + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + + end; // pop up still visible, has not reached it's position - move it + end; // loop through all players + end; // if it's time to draw them + + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + end + + else if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end + + else if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end + + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); + end; + end; + end; +//PhrasenBonus - Line Bonus Mod 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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: +// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + + // Golden Note Patch + case Wartosc of + 0: glColor4f(1, 1, 1, 0.35); + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; +begin + x := Theme.Sing.StaticTimeProgress.x; + y := Theme.Sing.StaticTimeProgress.y; + width:= Theme.Sing.StaticTimeProgress.w; + height:= Theme.Sing.StaticTimeProgress.h; + + glColor4f(Theme.Sing.StaticTimeProgress.ColR, + Theme.Sing.StaticTimeProgress.ColG, + Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + + glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(x,y); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); + glTexCoord2f(0, 1); glVertex2f(x, y+height); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1,1,1,1); +end; + +end. + diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index eb7dde8e..aaa4b3d7 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,607 +1,611 @@ -unit UGraphic; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses - SDL, - OpenGL12, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - - //Notes - Tex_Left: array[0..6] of TTexture; //rename to tex_note_left - Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid - Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - - Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left - Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_SzczytR = 0.8; - Skin_SzczytG = 0; - Skin_SzczytB = 0; - - Skin_SzczytLimitR = 0; - Skin_SzczytLimitG = 0.8; - Skin_SzczytLimitB = 0; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_LyricsT = 494; // 500 / 510 / 400 - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses UMain, - UIni, - UDisplay, - UCommandLine, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - Classes, - Windows; - -procedure LoadTextures; - - -var - P: integer; - R, G, B: real; - Col: integer; -begin - // zaladowanie tekstur - Log.LogStatus('Loading Textures', 'LoadTextures'); - Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? - - // P1-6 - for P := 1 to 6 do begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); - - Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); - Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); - Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); - end; - - Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); - Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); - Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); - //end Singbar Mod - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); - end; - {//Set Texture to Font High - Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; - Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; - Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } - //PhrasenBonus - Line Bonus Mod End - - // tworzenie czcionek - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure Initialize3D (Title: string); -var -// Icon: TIcon; - Res: TResourceStream; - ISurface: PSDL_Surface; - Pixel: PByteArray; - I: Integer; -begin - Log.LogStatus('LoadOpenGL', 'Initialize3D'); - Log.BenchmarkStart(2); - - LoadOpenGL; - - Log.LogStatus('SDL_Init', 'Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin - Log.LogError('SDL_Init Failed', 'Initialize3D'); - exit; - end; - - { //Load Icon - Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); - Icon := TIcon.Create; - Icon.LoadFromStream(Res); - Res.Free; - Icon. - //Create icon Surface - SDL_CreateRGBSurfaceFrom ( - SDL_SWSURFACE, - Icon.Width, - Icon.Height, - 32, - 128 or 64, - 32 or 16, - 8 or 4, - 2 or 1); - //SDL_BlitSurface( - - - SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} - - SDL_WM_SetCaption(PChar(Title), nil); - - InitializeScreen; - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Setting Screen', 2); - - // ladowanie tekstur - Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - Texture.Limit := 1024*1024; - - LoadTextures; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Textures', 2); - - Log.BenchmarkStart(2); - Lyric := TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); - - Log.BenchmarkStart(2); - Display := TDisplay.Create; - SDL_EnableUnicode(1); - Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - - Log.LogStatus('Loading Screens', 'Initialize3D'); - Log.BenchmarkStart(3); - - LoadLoadingScreen; - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar -// Mutex := SDL_CreateMutex; -// SDL_UnLockMutex(Mutex); - - // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will - // siehe dazu kommentar unten - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // das hier würde dann im ladethread ausgeführt - LoadScreens; - - - // TODO!!!!!!1 - // hier käme jetzt eine schleife, die - // * den ladescreen malt (ab und zu) - // * den "fortschritt" des ladescreens steuert - // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und - // * die texturen in die opengl lädt, sowie - // * dem ladethread signalisiert, dass der speicher für die textur - // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) - // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, - // dass er alles geladen hat fertig ist - // - // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche - // opengl funktionen aufzurufen, entsprechend mutexe verändert - // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, - // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... - - - //wait for loading thread to finish - // funktioniert so auch noch nicht - //SDL_WaitThread(LoadingThread, I); -// SDL_DestroyMutex(Mutex); - - Display.ActualScreen^.FadeTo(@ScreenMain); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin -// InitializeScreen; -// LoadTextures; -// LoadScreens; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - {if ParamStr(1) = '-fsblack' then begin - W := 800; - H := 600; - end; - if ParamStr(1) = '-320x240' then begin - W := 320; - H := 240; - end; } - - If (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); -// SDL_SetRefreshrate(85); -// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - if (Ini.FullScreen = 0) and (Not Params.FullScreen) then - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) - else begin - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); - end; - if (screen = nil) then begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; - end; - - // clear screen once window is being shown - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; - - // zmienne - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - swapbuffers; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - ScreenPartyNewRound := TScreenPartyNewRound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); - ScreenPartyScore := TScreenPartyScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - - end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -end. +unit UGraphic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + {$IFDEF win32} + windows, + {$ENDIF} + Classes; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + + // P1-6 + for P := 1 to 6 do begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + end; + + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); + end; + {//Set Texture to Font High + Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; + Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; + Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } + //PhrasenBonus - Line Bonus Mod End + + // tworzenie czcionek + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure Initialize3D (Title: string); +var +// Icon: TIcon; + Res: TResourceStream; + ISurface: PSDL_Surface; + Pixel: PByteArray; + I: Integer; +begin + Log.LogStatus('LoadOpenGL', 'Initialize3D'); + Log.BenchmarkStart(2); + + LoadOpenGL; + + Log.LogStatus('SDL_Init', 'Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin + Log.LogError('SDL_Init Failed', 'Initialize3D'); + exit; + end; + + { //Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + Icon. + //Create icon Surface + SDL_CreateRGBSurfaceFrom ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + //SDL_BlitSurface( + + + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} + + SDL_WM_SetCaption(PChar(Title), nil); + + InitializeScreen; + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur + Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + + LoadTextures; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Textures', 2); + + Log.BenchmarkStart(2); + Lyric := TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); + + Log.BenchmarkStart(2); + Display := TDisplay.Create; + SDL_EnableUnicode(1); + Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + + Log.LogStatus('Loading Screens', 'Initialize3D'); + Log.BenchmarkStart(3); + + LoadLoadingScreen; + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // das hier würde dann im ladethread ausgeführt + LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + + + //wait for loading thread to finish + // funktioniert so auch noch nicht + //SDL_WaitThread(LoadingThread, I); +// SDL_DestroyMutex(Mutex); + + Display.ActualScreen^.FadeTo(@ScreenMain); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + {if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) + else begin + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end; + if (screen = nil) then begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + swapbuffers; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + + end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +end. diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 761ec058..c04a0ad8 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -1,667 +1,678 @@ -// notes: -unit UGraphicClasses; - -interface -uses UTexture; - -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, - Windows, - OpenGl12, - 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 ?? die werden doch aber im Manager bei Draw getötet, wenns 0 is - 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 := GetTickCount; - 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 := GetTickCount; - //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 + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses UTexture; + +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, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGl12, + 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 ?? die werden doch aber im Manager bei Draw getötet, wenns 0 is + 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 := GetTickCount; + 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 := GetTickCount; + //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/UJoystick.pas b/Game/Code/Classes/UJoystick.pas index b0c7b8cc..6b4ea63f 100644 --- a/Game/Code/Classes/UJoystick.pas +++ b/Game/Code/Classes/UJoystick.pas @@ -1,273 +1,282 @@ -unit UJoystick; - -interface - -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, Windows, ULog; - -constructor TJoy.Create; -var - B, N: integer; -begin - //Old Corvus5 Method - {// joystick support - SDL_JoystickEventState(SDL_IGNORE); - SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks <> 1 then beep; - - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then beep; - - if SDL_JoystickNumButtons(SDL_Joy) <> 16 then beep; - -// 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 beep; - - 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 := Gettickcount; - - //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, + {$IFDEF win32} + windows, + {$ELSE} + LCLIntf, + {$ENDIF} + ULog; + +constructor TJoy.Create; +var + B, N: integer; +begin + //Old Corvus5 Method + {// joystick support + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks <> 1 then beep; + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then beep; + + if SDL_JoystickNumButtons(SDL_Joy) <> 16 then beep; + +// 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 beep; + + 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 := Gettickcount; + + //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/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index f693694b..679f6405 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -1,234 +1,236 @@ -unit ULanguage; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -type - TLanguageEntry = record - ID: string; - Text: string; - end; - - TLanguageList = record - Name: string; - {FileName: string; } - end; - - TLanguage = class - public - Entry: array of TLanguageEntry; //Entrys of Chosen Language - SEntry: array of TLanguageEntry; //Entrys of Standard Language - CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version - Implode_Glue1, Implode_Glue2: String; - public - List: array of TLanguageList; - - constructor Create; - procedure LoadList; - function Translate(Text: String): String; - procedure ChangeLanguage(Language: String); - procedure AddConst(ID, Text: String); - procedure ChangeConst(ID, Text: String); - function Implode(Pieces: Array of String): String; - end; - -var - Language: TLanguage; - -implementation - -uses UMain, - // UFiles, - UIni, - IniFiles, - Classes, - SysUtils, - Windows, - ULog; - -//---------- -//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues -//---------- -constructor TLanguage.Create; -var - I, J: Integer; -begin - LoadList; - - //Set Implode Glues for Backward Compatibility - Implode_Glue1 := ', '; - Implode_Glue2 := ' and '; - - if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading - Log.CriticalError('Could not load any Language File'); - - //Standard Language (If a Language File is Incomplete) - //Then use English Language - for I := 0 to high(List) do //Search for English Language - begin - //English Language Found -> Load - if Uppercase(List[I].Name) = 'ENGLISH' then - begin - ChangeLanguage('English'); - - SetLength(SEntry, Length(Entry)); - for J := low(Entry) to high(Entry) do - SEntry[J] := Entry[J]; - - SetLength(Entry, 0); - - Break; - end; - - if (I = high(List)) then - Log.LogError('English Languagefile missing! No standard Translation loaded'); - end; - //Standard Language END - -end; - -//---------- -//LoadList - Parse the Language Dir searching Translations -//---------- -procedure TLanguage.LoadList; -var - SR: TSearchRec; // for parsing directory -begin - SetLength(List, 0); - SetLength(ILanguage, 0); - - if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin - repeat - SetLength(List, Length(List)+1); - SetLength(ILanguage, Length(ILanguage)+1); - SR.Name := ChangeFileExt(SR.Name, ''); - - List[High(List)].Name := SR.Name; - ILanguage[High(ILanguage)] := SR.Name; - - until FindNext(SR) <> 0; - SysUtils.FindClose(SR); - end; // if FindFirst -end; - -//---------- -//ChangeLanguage - Load the specified LanguageFile -//---------- -procedure TLanguage.ChangeLanguage(Language: String); -var - IniFile: TIniFile; - E: integer; // entry - S: TStringList; -begin - SetLength(Entry, 0); - IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); - S := TStringList.Create; - - IniFile.ReadSectionValues('Text', S); - SetLength(Entry, S.Count); - for E := 0 to high(Entry) do - begin - if S.Names[E] = 'IMPLODE_GLUE1' then - Implode_Glue1 := S.ValueFromIndex[E]+ ' ' - else if S.Names[E] = 'IMPLODE_GLUE2' then - Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; - - Entry[E].ID := S.Names[E]; - Entry[E].Text := S.ValueFromIndex[E]; - end; - - S.Free; - IniFile.Free; -end; - -//---------- -//Translate - Translate the Text -//---------- -Function TLanguage.Translate(Text: String): String; -var - E: integer; // entry -begin - Result := Text; - Text := Uppercase(Result); - - //Const Mod - for E := 0 to high(CEntry) do - if Text = CEntry[E].ID then - begin - Result := CEntry[E].Text; - exit; - end; - //Const Mod End - - for E := 0 to high(Entry) do - if Text = Entry[E].ID then - begin - Result := Entry[E].Text; - exit; - end; - - //Standard Language (If a Language File is Incomplete) - //Then use Standard Language - for E := low(SEntry) to high(SEntry) do - if Text = SEntry[E].ID then - begin - Result := SEntry[E].Text; - Break; - end; - //Standard Language END -end; - -//---------- -//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile -//---------- -procedure TLanguage.AddConst (ID, Text: String); -begin - SetLength (CEntry, Length(CEntry) + 1); - CEntry[high(CEntry)].ID := ID; - CEntry[high(CEntry)].Text := Text; -end; - -//---------- -//ChangeConst - Change a Constant Value by ID -//---------- -procedure TLanguage.ChangeConst(ID, Text: String); -var - I: Integer; -begin - for I := 0 to high(CEntry) do - begin - if CEntry[I].ID = ID then - begin - CEntry[I].Text := Text; - Break; - end; - end; -end; - -//---------- -//Implode - Connect an Array of Strings with ' and ' or ', ' to one String -//---------- -function TLanguage.Implode(Pieces: Array of String): String; -var - I: Integer; -begin - Result := ''; - //Go through Pieces - for I := low(Pieces) to high(Pieces) do - begin - //Add Value - Result := Result + Pieces[I]; - - //Add Glue - if (I < high(Pieces) - 1) then - Result := Result + Implode_Glue1 - else if (I < high(Pieces)) then - Result := Result + Implode_Glue2; - end; -end; - -end. +unit ULanguage; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +type + TLanguageEntry = record + ID: string; + Text: string; + end; + + TLanguageList = record + Name: string; + {FileName: string; } + end; + + TLanguage = class + public + Entry: array of TLanguageEntry; //Entrys of Chosen Language + SEntry: array of TLanguageEntry; //Entrys of Standard Language + CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version + Implode_Glue1, Implode_Glue2: String; + public + List: array of TLanguageList; + + constructor Create; + procedure LoadList; + function Translate(Text: String): String; + procedure ChangeLanguage(Language: String); + procedure AddConst(ID, Text: String); + procedure ChangeConst(ID, Text: String); + function Implode(Pieces: Array of String): String; + end; + +var + Language: TLanguage; + +implementation + +uses UMain, + // UFiles, + UIni, + IniFiles, + Classes, + SysUtils, + {$IFDEF win32} + windows, + {$ENDIF} + ULog; + +//---------- +//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues +//---------- +constructor TLanguage.Create; +var + I, J: Integer; +begin + LoadList; + + //Set Implode Glues for Backward Compatibility + Implode_Glue1 := ', '; + Implode_Glue2 := ' and '; + + if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading + Log.CriticalError('Could not load any Language File'); + + //Standard Language (If a Language File is Incomplete) + //Then use English Language + for I := 0 to high(List) do //Search for English Language + begin + //English Language Found -> Load + if Uppercase(List[I].Name) = 'ENGLISH' then + begin + ChangeLanguage('English'); + + SetLength(SEntry, Length(Entry)); + for J := low(Entry) to high(Entry) do + SEntry[J] := Entry[J]; + + SetLength(Entry, 0); + + Break; + end; + + if (I = high(List)) then + Log.LogError('English Languagefile missing! No standard Translation loaded'); + end; + //Standard Language END + +end; + +//---------- +//LoadList - Parse the Language Dir searching Translations +//---------- +procedure TLanguage.LoadList; +var + SR: TSearchRec; // for parsing directory +begin + SetLength(List, 0); + SetLength(ILanguage, 0); + + if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin + repeat + SetLength(List, Length(List)+1); + SetLength(ILanguage, Length(ILanguage)+1); + SR.Name := ChangeFileExt(SR.Name, ''); + + List[High(List)].Name := SR.Name; + ILanguage[High(ILanguage)] := SR.Name; + + until FindNext(SR) <> 0; + SysUtils.FindClose(SR); + end; // if FindFirst +end; + +//---------- +//ChangeLanguage - Load the specified LanguageFile +//---------- +procedure TLanguage.ChangeLanguage(Language: String); +var + IniFile: TIniFile; + E: integer; // entry + S: TStringList; +begin + SetLength(Entry, 0); + IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); + S := TStringList.Create; + + IniFile.ReadSectionValues('Text', S); + SetLength(Entry, S.Count); + for E := 0 to high(Entry) do + begin + if S.Names[E] = 'IMPLODE_GLUE1' then + Implode_Glue1 := S.ValueFromIndex[E]+ ' ' + else if S.Names[E] = 'IMPLODE_GLUE2' then + Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; + + Entry[E].ID := S.Names[E]; + Entry[E].Text := S.ValueFromIndex[E]; + end; + + S.Free; + IniFile.Free; +end; + +//---------- +//Translate - Translate the Text +//---------- +Function TLanguage.Translate(Text: String): String; +var + E: integer; // entry +begin + Result := Text; + Text := Uppercase(Result); + + //Const Mod + for E := 0 to high(CEntry) do + if Text = CEntry[E].ID then + begin + Result := CEntry[E].Text; + exit; + end; + //Const Mod End + + for E := 0 to high(Entry) do + if Text = Entry[E].ID then + begin + Result := Entry[E].Text; + exit; + end; + + //Standard Language (If a Language File is Incomplete) + //Then use Standard Language + for E := low(SEntry) to high(SEntry) do + if Text = SEntry[E].ID then + begin + Result := SEntry[E].Text; + Break; + end; + //Standard Language END +end; + +//---------- +//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile +//---------- +procedure TLanguage.AddConst (ID, Text: String); +begin + SetLength (CEntry, Length(CEntry) + 1); + CEntry[high(CEntry)].ID := ID; + CEntry[high(CEntry)].Text := Text; +end; + +//---------- +//ChangeConst - Change a Constant Value by ID +//---------- +procedure TLanguage.ChangeConst(ID, Text: String); +var + I: Integer; +begin + for I := 0 to high(CEntry) do + begin + if CEntry[I].ID = ID then + begin + CEntry[I].Text := Text; + Break; + end; + end; +end; + +//---------- +//Implode - Connect an Array of Strings with ' and ' or ', ' to one String +//---------- +function TLanguage.Implode(Pieces: Array of String): String; +var + I: Integer; +begin + Result := ''; + //Go through Pieces + for I := low(Pieces) to high(Pieces) do + begin + //Add Value + Result := Result + Pieces[I]; + + //Add Glue + if (I < high(Pieces) - 1) then + Result := Result + Implode_Glue1 + else if (I < high(Pieces)) then + Result := Result + Implode_Glue2; + end; +end; + +end. diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 74681a85..99edc88c 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -1,149 +1,162 @@ -unit ULight; -interface -{$I switches.inc} - -type - TLight = class - private - Enabled: boolean; - Light: array[0..7] of boolean; - LightTime: array[0..7] of real; // time to stop, need to call update to change state - LastTime: real; - public - constructor Create; - procedure Enable; - procedure SetState(State: integer); - procedure AutoSetState; - procedure TurnOn; - procedure TurnOff; - procedure LightOne(Number: integer; Time: real); - procedure Refresh; - end; - -var - Light: TLight; - -const - Data = $378; // default port address - Status = Data + 1; - Control = Data + 2; - -implementation - -uses - SysUtils, - {$IFDEF UseSerialPort} - zlportio, - {$ENDIF} - UTime; - -{$IFDEF FPC} - function GetTime: TDateTime; - {$IFDEF MSWINDOWS} - var - SystemTime: TSystemTime; - begin - GetLocalTime(SystemTime); - with SystemTime do - Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); - end; - {$ENDIF} - {$IFDEF LINUX} - var - T: TTime_T; - TV: TTimeVal; - UT: TUnixTime; - begin - gettimeofday(TV, nil); - T := TV.tv_sec; - localtime_r(@T, UT); - Result := EncodeTime(UT.tm_hour, UT.tm_min, UT.tm_sec, TV.tv_usec div 1000); - end; - {$ENDIF} -{$ENDIF} - - -constructor TLight.Create; -begin - Enabled := false; -end; - -procedure TLight.Enable; -begin - Enabled := true; - LastTime := GetTime; -end; - -procedure TLight.SetState(State: integer); -begin - {$IFDEF UseSerialPort} - if Enabled then - PortWriteB($378, State); - {$ENDIF} -end; - -procedure TLight.AutoSetState; -var - State: integer; -begin - if Enabled then begin - State := 0; - if Light[0] then State := State + 2; - if Light[1] then State := State + 1; - // etc - SetState(State); - end; -end; - -procedure TLight.TurnOn; -begin - if Enabled then - SetState(3); -end; - -procedure TLight.TurnOff; -begin - if Enabled then - SetState(0); -end; - -procedure TLight.LightOne(Number: integer; Time: real); -begin - if Enabled then begin - if Light[Number] = false then begin - Light[Number] := true; - AutoSetState; - end; - - LightTime[Number] := GetTime + Time/1000; // [s] - end; -end; - -procedure TLight.Refresh; -var - Time: real; -// TimeSkip: real; - L: integer; -begin - if Enabled then begin - Time := GetTime; -// TimeSkip := Time - LastTime; - for L := 0 to 7 do begin - if Light[L] = true then begin - if LightTime[L] > Time then begin - // jest jeszcze zapas - bez zmian - //LightTime[L] := LightTime[L] - TimeSkip; - end else begin - // czas minal - Light[L] := false; - end; - end; - end; - LastTime := Time; - AutoSetState; - end; -end; - -end. - - +unit ULight; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TLight = class + private + Enabled: boolean; + Light: array[0..7] of boolean; + LightTime: array[0..7] of real; // time to stop, need to call update to change state + LastTime: real; + public + constructor Create; + procedure Enable; + procedure SetState(State: integer); + procedure AutoSetState; + procedure TurnOn; + procedure TurnOff; + procedure LightOne(Number: integer; Time: real); + procedure Refresh; + end; + +var + Light: TLight; + +const + Data = $378; // default port address + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + {$IFNDEF win32} + libc, + {$ENDIF} + UTime; + +{$IFDEF FPC} + + function GetTime: TDateTime; + {$IFDEF win32} + var + SystemTime: TSystemTime; + begin + GetLocalTime(SystemTime); + with SystemTime do + Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); + end; + {$ELSE} + Type + Time_t = longint; + TTime_T = Time_t; + var + T : TTime_T; + TV: TTimeVal; + UT: TUnixTime; + begin + gettimeofday(TV, nil); + T := TV.tv_sec; + localtime_r(@T, @UT); + Result := EncodeTime(UT.tm_hour, UT.tm_min, UT.tm_sec, TV.tv_usec div 1000); + end; + {$ENDIF} + +{$ENDIF} + + +constructor TLight.Create; +begin + Enabled := false; +end; + +procedure TLight.Enable; +begin + Enabled := true; + LastTime := GetTime; +end; + +procedure TLight.SetState(State: integer); +begin + {$IFDEF UseSerialPort} + if Enabled then + PortWriteB($378, State); + {$ENDIF} +end; + +procedure TLight.AutoSetState; +var + State: integer; +begin + if Enabled then begin + State := 0; + if Light[0] then State := State + 2; + if Light[1] then State := State + 1; + // etc + SetState(State); + end; +end; + +procedure TLight.TurnOn; +begin + if Enabled then + SetState(3); +end; + +procedure TLight.TurnOff; +begin + if Enabled then + SetState(0); +end; + +procedure TLight.LightOne(Number: integer; Time: real); +begin + if Enabled then begin + if Light[Number] = false then begin + Light[Number] := true; + AutoSetState; + end; + + LightTime[Number] := GetTime + Time/1000; // [s] + end; +end; + +procedure TLight.Refresh; +var + Time: real; +// TimeSkip: real; + L: integer; +begin + if Enabled then begin + Time := GetTime; +// TimeSkip := Time - LastTime; + for L := 0 to 7 do begin + if Light[L] = true then begin + if LightTime[L] > Time then begin + // jest jeszcze zapas - bez zmian + //LightTime[L] := LightTime[L] - TimeSkip; + end else begin + // czas minal + Light[L] := false; + end; + end; + end; + LastTime := Time; + AutoSetState; + end; +end; + +end. + + diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index d03ad8ed..7c93c6e9 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -1,243 +1,253 @@ -unit ULog; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses Classes; - -type - TLog = class - BenchmarkTimeStart: array[0..7] of real; - BenchmarkTimeLength: array[0..7] of real;//TDateTime; - - FileBenchmark: TextFile; - FileBenchmarkO: boolean; // opened - FileError: TextFile; - FileErrorO: boolean; // opened - - Title: String; //Application Title - - //Should Log Files be written - Enabled: Boolean; - - // destuctor - destructor Free; - - // benchmark - procedure BenchmarkStart(Number: integer); - procedure BenchmarkEnd(Number: integer); - procedure LogBenchmark(Text: string; Number: integer); - - // error - procedure LogError(Text: string); overload; - - //Critical Error (Halt + MessageBox) - procedure CriticalError(Text: string); - - // voice - procedure LogVoice(SoundNr: integer); - - // compability - procedure LogStatus(Log1, Log2: string); - procedure LogError(Log1, Log2: string); overload; - end; - -var - Log: TLog; - -implementation - -uses - Windows, - SysUtils, - DateUtils, -// UFiles, - UMain, - URecord, - UTime, -// UIni, // JB - Seems to not be needed. - UCommandLine; - -destructor TLog.Free; -begin - if FileBenchmarkO then CloseFile(FileBenchmark); -// if FileAnalyzeO then CloseFile(FileAnalyze); - if FileErrorO then CloseFile(FileError); -end; - -procedure TLog.BenchmarkStart(Number: integer); -begin - BenchmarkTimeStart[Number] := USTime.GetTime; //Time; -end; - -procedure TLog.BenchmarkEnd(Number: integer); -begin - BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; -end; - -procedure TLog.LogBenchmark(Text: string; Number: integer); -var - Minutes: integer; - Seconds: integer; - Miliseconds: integer; - - MinutesS: string; - SecondsS: string; - MilisecondsS: string; - - ValueText: string; -begin - if Enabled AND (Params.Benchmark) then begin - if not FileBenchmarkO then begin - FileBenchmarkO := true; - AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); - {$I-} - Rewrite(FileBenchmark); - if IOResult = 0 then FileBenchmarkO := true; - {$I+} - - //If File is opened write Date to Benchmark File - If (FileBenchmarkO) then - begin - WriteLn(FileBenchmark, Title + ' Benchmark File'); - WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileBenchmark, '-------------------'); - - Flush(FileBenchmark); - end; - end; - - if FileBenchmarkO then begin - Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); - Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; - Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); -// ValueText := FloatToStr(BenchmarkTimeLength[Number]); - -{ ValueText := FloatToStr( - SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 - ); - if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then - ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; - WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} - - if (Minutes = 0) and (Seconds = 0) then begin - MilisecondsS := IntToStr(Miliseconds); - ValueText := MilisecondsS + ' miliseconds'; - end; - - if (Minutes = 0) and (Seconds >= 1) then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - - ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; - end; - - if Minutes >= 1 then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; - - MinutesS := IntToStr(Minutes); - - ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; - end; - - WriteLn(FileBenchmark, Text + ': ' + ValueText); - Flush(FileBenchmark); - end; - end; -end; - -procedure TLog.LogError(Text: string); -begin - if Enabled AND (not FileErrorO) then begin - FileErrorO := true; - AssignFile(FileError, LogPath + 'Error.log'); - {$I-} - Rewrite(FileError); - if IOResult = 0 then FileErrorO := true; - {$I+} - - //If File is opened write Date to Error File - If (FileErrorO) then - begin - WriteLn(FileError, Title + ' Error Log'); - WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileError, '-------------------'); - - Flush(FileError); - end; - end; - - if FileErrorO then begin - try - WriteLn(FileError, Text); - Flush(FileError); - except - FileErrorO := false; - end; - end; -end; - -procedure TLog.LogVoice(SoundNr: integer); -var - FileVoice: File; - FS: TFileStream; - FileName: string; - Num: integer; - BL: integer; -begin - for Num := 1 to 9999 do begin - FileName := IntToStr(Num); - while Length(FileName) < 4 do FileName := '0' + FileName; - FileName := LogPath + 'Voice' + FileName + '.raw'; - if not FileExists(FileName) then break - end; - - - FS := TFileStream.Create(FileName, fmCreate); - - for BL := 0 to High(Sound[SoundNr].BufferLong) do begin - Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); - FS.CopyFrom(Sound[SoundNr].BufferLong[BL], Sound[SoundNr].BufferLong[BL].Size); - end; - - FS.Free; -end; - -procedure TLog.LogStatus(Log1, Log2: string); -begin - //Just for Debugging - //Comment for Release - //LogAnalyze (Log2 + ': ' + Log1); - - LogError(Log2 + ': ' + Log1); -end; - -procedure TLog.LogError(Log1, Log2: string); -begin -//asd -end; - -procedure TLog.CriticalError(Text: string); -begin - //Write Error to Logfile: - LogError (Text); - - //Show Errormessage - Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); - - //Exit Application - Halt; -end; - -end. - - +unit ULog; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses Classes; + +type + TLog = class + BenchmarkTimeStart: array[0..7] of real; + BenchmarkTimeLength: array[0..7] of real;//TDateTime; + + FileBenchmark: TextFile; + FileBenchmarkO: boolean; // opened + FileError: TextFile; + FileErrorO: boolean; // opened + + Title: String; //Application Title + + //Should Log Files be written + Enabled: Boolean; + + // destuctor + destructor Free; + + // benchmark + procedure BenchmarkStart(Number: integer); + procedure BenchmarkEnd(Number: integer); + procedure LogBenchmark(Text: string; Number: integer); + + // error + procedure LogError(Text: string); overload; + + //Critical Error (Halt + MessageBox) + procedure CriticalError(Text: string); + + // voice + procedure LogVoice(SoundNr: integer); + + // compability + procedure LogStatus(Log1, Log2: string); + procedure LogError(Log1, Log2: string); overload; + end; + +var + Log: TLog; + +implementation + +uses + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + DateUtils, +// UFiles, + UMain, + URecord, + UTime, +// UIni, // JB - Seems to not be needed. + UCommandLine; + +destructor TLog.Free; +begin + if FileBenchmarkO then CloseFile(FileBenchmark); +// if FileAnalyzeO then CloseFile(FileAnalyze); + if FileErrorO then CloseFile(FileError); +end; + +procedure TLog.BenchmarkStart(Number: integer); +begin + BenchmarkTimeStart[Number] := USTime.GetTime; //Time; +end; + +procedure TLog.BenchmarkEnd(Number: integer); +begin + BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; +end; + +procedure TLog.LogBenchmark(Text: string; Number: integer); +var + Minutes: integer; + Seconds: integer; + Miliseconds: integer; + + MinutesS: string; + SecondsS: string; + MilisecondsS: string; + + ValueText: string; +begin + if Enabled AND (Params.Benchmark) then begin + if not FileBenchmarkO then begin + FileBenchmarkO := true; + AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); + {$I-} + Rewrite(FileBenchmark); + if IOResult = 0 then FileBenchmarkO := true; + {$I+} + + //If File is opened write Date to Benchmark File + If (FileBenchmarkO) then + begin + WriteLn(FileBenchmark, Title + ' Benchmark File'); + WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileBenchmark, '-------------------'); + + Flush(FileBenchmark); + end; + end; + + if FileBenchmarkO then begin + Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); + Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; + Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); +// ValueText := FloatToStr(BenchmarkTimeLength[Number]); + +{ ValueText := FloatToStr( + SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 + ); + if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then + ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; + WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} + + if (Minutes = 0) and (Seconds = 0) then begin + MilisecondsS := IntToStr(Miliseconds); + ValueText := MilisecondsS + ' miliseconds'; + end; + + if (Minutes = 0) and (Seconds >= 1) then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + + ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; + end; + + if Minutes >= 1 then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; + + MinutesS := IntToStr(Minutes); + + ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; + end; + + WriteLn(FileBenchmark, Text + ': ' + ValueText); + Flush(FileBenchmark); + end; + end; +end; + +procedure TLog.LogError(Text: string); +begin + if Enabled AND (not FileErrorO) then begin + FileErrorO := true; + AssignFile(FileError, LogPath + 'Error.log'); + {$I-} + Rewrite(FileError); + if IOResult = 0 then FileErrorO := true; + {$I+} + + //If File is opened write Date to Error File + If (FileErrorO) then + begin + WriteLn(FileError, Title + ' Error Log'); + WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileError, '-------------------'); + + Flush(FileError); + end; + end; + + if FileErrorO then begin + try + WriteLn(FileError, Text); + Flush(FileError); + except + FileErrorO := false; + end; + end; +end; + +procedure TLog.LogVoice(SoundNr: integer); +var + FileVoice: File; + FS: TFileStream; + FileName: string; + Num: integer; + BL: integer; +begin + for Num := 1 to 9999 do begin + FileName := IntToStr(Num); + while Length(FileName) < 4 do FileName := '0' + FileName; + FileName := LogPath + 'Voice' + FileName + '.raw'; + if not FileExists(FileName) then break + end; + + + FS := TFileStream.Create(FileName, fmCreate); + + for BL := 0 to High(Sound[SoundNr].BufferLong) do begin + Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); + FS.CopyFrom(Sound[SoundNr].BufferLong[BL], Sound[SoundNr].BufferLong[BL].Size); + end; + + FS.Free; +end; + +procedure TLog.LogStatus(Log1, Log2: string); +begin + //Just for Debugging + //Comment for Release + //LogAnalyze (Log2 + ': ' + Log1); + + LogError(Log2 + ': ' + Log1); +end; + +procedure TLog.LogError(Log1, Log2: string); +begin +//asd +end; + +procedure TLog.CriticalError(Text: string); +begin + //Write Error to Logfile: + LogError (Text); + + {$IFDEF win32} + //Show Errormessage + Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); + {$ELSE} + // TODO - JB_Linux handle critical error so user can see message. + writeln( 'Critical ERROR :' ); + writeln( Text ); + {$ENDIF} + + //Exit Application + Halt; +end; + +end. + + diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 646724df..f06345ec 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,781 +1,792 @@ -unit UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses SDL, UGraphic, UMusic, URecord, UTime, SysUtils, UDisplay, UIni, ULog, ULyrics, UScreenSing, - OpenGL12, - - {$IFDEF UseSerialPort} - zlportio {you can disable it and all PortWriteB calls}, - {$ENDIF} - - ULCD, ULight, UThemes{, UScreenPopup}; - -type - TPlayer = record - Name: string; - - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreI: integer; - ScoreLineI: integer; - ScoreGoldenI: integer; - ScoreTotalI: integer; - - - - //SingBar Mod - ScoreLast: Real;//Last Line Score - ScorePercent: integer;//Aktual Fillstate of the SingBar - ScorePercentTarget: integer;//Target Fillstate of the SingBar - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: Single; - LineBonus_PosY: Single; - LineBonus_Alpha: Single; - LineBonus_Visible: boolean; - LineBonus_Text: string; - LineBonus_Color: TRGB; - LineBonus_Age: Integer; - LineBonus_Rating: Integer; - //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes - LineBonus_TargetX: integer; - LineBonus_TargetY: integer; - LineBonus_StartX: integer; - LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End - - //PerfectLineTwinkle Mod (effect) - LastSentencePerfect: Boolean; - //PerfectLineTwinkle Mod end - - -// Meter: real; - - HighNut: integer; - IlNut: integer; - Nuta: array of record - Start: integer; - Dlugosc: integer; - Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute - Ton: real; - Perfect: boolean; // true if the note matches the original one, lit the star - - - - // Half size Notes Patch - Hit: boolean; // true if the note Hits the Line - //end Half size Notes Patch - - - - end; - end; - - -var - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; - - OGL: Boolean; - Done: Boolean; - Event: TSDL_event; - FileName: string; - Restart: boolean; - - // gracz i jego nuty - Player: array of TPlayer; - PlayersPlay: integer; - -procedure InitializePaths; - -procedure MainLoop; -procedure CheckEvents; -procedure Sing(Sender: TScreenSing); -procedure NewSentence(Sender: TScreenSing); -procedure NewBeat(Sender: TScreenSing); // executed when on then new beat -procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click -procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection -//procedure NewHalf; // executed when in the half between beats -procedure NewNote(Sender: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - -implementation -uses USongs, UJoystick, math, UCommandLine; - -procedure MainLoop; -var - Delay: integer; -begin - SDL_EnableKeyRepeat(125, 125); - While not Done do - Begin - // joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - done := not Display.Draw; - SwapBuffers; - - // light - Light.Refresh; - - // delay - CountMidTime; -// if 1000*TimeMid > 100 then beep; - Delay := Floor(1000 / 100 - 1000 * TimeMid); - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - CountSkipTime; - - // reinitialization of graphics - if Restart then begin - Reinitialize3D; - Restart := false; - end; - - End; - UnloadOpenGL; -End; - -Procedure CheckEvents; -//var -// p: pointer; -Begin - if not Assigned(Display.NextScreen) then - While SDL_PollEvent( @event ) = 1 Do - Begin -// beep; - Case Event.type_ Of - SDL_QUITEV: begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; -{ SDL_MOUSEBUTTONDOWN: - With Event.button Do - Begin - If State = SDL_BUTTON_LEFT Then - Begin - // - End; - End; // With} - SDL_KEYDOWN: - begin - //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path - if (Event.key.keysym.sym = SDLK_SYSREQ) then - Display.ScreenShot - - // popup hack... if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - // end of popup hack - - else - begin - // check for Screen want to Exit - done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); - - //If Screen wants to Exit - if done then - begin - //If Question Option is enabled then Show Exit Popup - if (Ini.AskbeforeDel = 1) then - begin - Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); - end - else //When asking for exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - end; - - end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then - end; -// SDL_JOYAXISMOTION: -// begin -// beep -// end; - SDL_JOYBUTTONDOWN: - begin - beep - end; - End; // Case Event.type_ - End; // While -End; // CheckEvents - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(AktSong.BPM) = BPMNum then begin - // last BPM - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end else begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then begin - // there is still remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end else begin - // there is no remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -// TopBeat: real; -// TempBeat: real; -// TempTime: real; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; - - (* 2 BPMs *) -{ if Length(AktSong.BPM) > 1 then begin - (* new system *) - CurBeat := 0; - TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); - if TopBeat > AktSong.BPM[1].StartBeat then begin - // analyze second BPM - Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); - CurBeat := AktSong.BPM[1].StartBeat; - TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); - Result := CurBeat + TopBeat; - - end else begin - (* pierwszy przedzial *) - Result := TopBeat; - end; - end; // if} - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end; // if -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - Result := AktSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin - if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin - // full range - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin - // in the middle - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - -{ while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end;} - end; // if} -end; - -procedure Sing(Sender: TScreenSing); -var - Pet: integer; - PetGr: integer; - CP: integer; - Done: real; - N: integer; -begin - Czas.Teraz := Czas.Teraz + TimeSkip; - - Czas.OldBeat := Czas.AktBeat; - Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function - Czas.AktBeat := Floor(Czas.MidBeat); - -// Czas.OldHalf := Czas.AktHalf; -// Czas.MidHalf := Czas.MidBeat + 0.5; -// Czas.AktHalf := Floor(Czas.MidHalf); - - Czas.OldBeatC := Czas.AktBeatC; - Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); - Czas.AktBeatC := Floor(Czas.MidBeatC); - - Czas.OldBeatD := Czas.AktBeatD; - Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP - Czas.AktBeatD := Floor(Czas.MidBeatD); - Czas.FracBeatD := Frac(Czas.MidBeatD); - - // sentences routines - for PetGr := 0 to 0 do begin;//High(Gracz) do begin - CP := PetGr; - // ustawianie starej czesci - Czas.OldCzesc := Czesci[CP].Akt; - - // wybieranie aktualnej czesci - for Pet := 0 to Czesci[CP].High do - if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; - - // czysczenie nut gracza, gdy to jest nowa plansza - // (optymizacja raz na halfbeat jest zla) - if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); - - end; // for PetGr - - // wykonuje operacje raz na beat - if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then - NewBeat(Sender); - - // make some operations on clicks - if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then - NewBeatC(Sender); - - // make some operations when detecting new voice pitch - if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then - NewBeatD(Sender); - - // wykonuje operacje w polowie beatu -// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then -// NewHalf; - - // plynnie przesuwa text - Done := 1; - for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) - and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then - Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); - - N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; - - // wylacza ostatnia nute po przejsciu - if (Ini.LyricsEffect = 1) and (Done = 1) and - (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) - then Sender.LyricMain.Selected := -1; - - if Done > 1 then Done := 1; - Sender.LyricMain.Done := Done; - - // use Done with LCD -{ with ScreenSing do begin - if LyricMain.Selected >= 0 then begin - LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); - LCD.ShowCursor; - end; - end;} - - -end; - -procedure NewSentence(Sender: TScreenSing); -var -G: Integer; -begin - // czyszczenie nut graczy - for G := 0 to High(Player) do begin - Player[G].IlNut := 0; - Player[G].HighNut := -1; - SetLength(Player[G].Nuta, 0); - end; - - // wstawianie tekstow - with Sender do begin - LyricMain.AddCzesc(Czesci[0].Akt); - if Czesci[0].Akt < Czesci[0].High then - LyricSub.AddCzesc(Czesci[0].Akt+1) - else - LyricSub.Clear; - end; - - Sender.UpdateLCD; - - //On Sentence Change... - Sender.onSentenceChange(Czesci[0].Akt); -end; - -procedure NewBeat(Sender: TScreenSing); -var - Pet: integer; -// TempBeat: integer; -begin - // ustawia zaznaczenie tekstu -// SingScreen.LyricMain.Selected := -1; - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin - // operates on currently beated note - Sender.LyricMain.Selected := Pet; - -// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); -// LCD.ShowCursor; - - LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); - LCD.ShowCursor; - - end; -end; - -procedure NewBeatC; -var - Pet: integer; -// LPT_1: integer; -// LPT_2: integer; -begin -// LPT_1 := 1; -// LPT_2 := 1; - - // beat click - if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - Music.PlayClick; - - // debug system on LPT - if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin - //LPT_1 := 0; -// Light.LightOne(0, 150); - - Light.LightOne(1, 200); // beat light - if ParamStr(1) = '-doublelights' then - Light.LightOne(0, 200); // beat light - - -{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then - Light.LightOne(0, 150) - else - Light.LightOne(1, 150)} - end; - - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin - // click assist - if Ini.ClickAssist = 1 then - Music.PlayClick; - - //LPT_2 := 0; - if ParamStr(1) <> '-doublelights' then - Light.LightOne(0, 150); //125 - - - // drum machine -(* TempBeat := Czas.AktBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; -// if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) - end; - - {$IFDEF UseSerialPort} - // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala - {$ENDIF} -end; - -procedure NewBeatD(Sender: TScreenSing); -begin - NewNote(Sender); -end; - -//procedure NewHalf; -//begin -// NewNote; -//end; - -procedure NewNote(Sender: TScreenSing); -var - CP: integer; // current player - S: integer; // sentence - SMin: integer; - SMax: integer; - SDet: integer; // temporary: sentence of detected note - Pet: integer; - Mozna: boolean; - Nowa: boolean; - Range: integer; - NoteHit:boolean; -begin -// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); -// beep; - - // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) - // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do begin - - // analyze buffer - Sound[CP].AnalizujBufor; - - // adds some noise -// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; - - // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SMin := Czesci[0].Akt-1; - if SMin < 0 then SMin := 0; - SMax := Czesci[0].Akt; - - // check if we can add new note - Mozna := false; - SDet:=SMin; - for S := SMin to SMax do - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) - and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 - then begin - SDet := S; - Mozna := true; - Break; - end; - - S := SDet; - - - - - -// Czas.SzczytJest := true; -// Czas.Ton := 27; - - // gdy moze, to dodaje nute - if (Sound[CP].SzczytJest) and (Mozna) then begin - // operowanie na ostatniej nucie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + - Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin - // to robi, tylko dla pary nut (oryginalnej i gracza) - - // przesuwanie tonu w odpowiednia game - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - Sound[CP].Ton := Sound[CP].Ton - 12; - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - Sound[CP].Ton := Sound[CP].Ton + 12; - - // Half size Notes Patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin - Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; - - - // Half size Notes Patch - NoteHit := true; - - - if (Ini.LineBonus = 0) then - begin - // add points without LineBonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end - else - begin - // add points with Line Bonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end; - - Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; - Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; - - Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; - end; - - end; // operowanie - - // sprawdzanie czy to nowa nuta, czy przedluzenie - if S = SMax then begin - Nowa := true; - // jezeli ostatnia ma ten sam ton - if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) - and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) - then Nowa := false; - // jezeli jest jakas nowa nuta na sprawdzanym beacie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then - Nowa := true; - - // dodawanie nowej nuty - if Nowa then begin - // nowa nuta - Player[CP].IlNut := Player[CP].IlNut + 1; - Player[CP].HighNut := Player[CP].HighNut + 1; - SetLength(Player[CP].Nuta, Player[CP].IlNut); - Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl - Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; - - - // Half Note Patch - Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; - - - // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); - - end else begin - // przedluzenie nuty - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; - end; - - - // check for perfect note and then lit the star (on Draw) - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) - and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin - Player[CP].Nuta[Player[CP].HighNut].Perfect := true; - end; - - end;// else beep; // if S = SMax - - end; // if moze - end; // for CP -// Log.LogStatus('EndBeat', 'NewBeat'); - -//On Sentence End -> For LineBonus + SingBar -if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then -if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then - Sender.onSentenceEnd(sDet); - -end; - -procedure ClearScores(PlayerNum: integer); -begin - Player[PlayerNum].Score := 0; - Player[PlayerNum].ScoreI := 0; - Player[PlayerNum].ScoreLine := 0; - Player[PlayerNum].ScoreLineI := 0; - Player[PlayerNum].ScoreGolden := 0; - Player[PlayerNum].ScoreGoldenI := 0; - Player[PlayerNum].ScoreTotalI := 0; - - - //SingBar Mod - Player[PlayerNum].ScoreLast := 0; - Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts - Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts - //end SingBar Mod - - //PhrasenBonus - Line Bonus Mod - Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus - Player[PlayerNum].LineBonus_Alpha := 0; - Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; - Player[PlayerNum].LineBonus_TargetY := 30; - //PhrasenBonus - Line Bonus Mod End -end; - -//-------------------- -// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist -//-------------------- -procedure InitializePaths; - - // Initialize a Path Variable - // After Setting Paths, make sure that Paths exist - function initialize_path( out aPathVar : String; const aLocation : String ): boolean; - var - lWriteable: Boolean; - begin - aPathVar := aLocation; - - If DirectoryExists(aPathVar) then - lWriteable := ForceDirectories(aPathVar) - else - lWriteable := false; - - if not lWriteable then - Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); - - result := lWriteable; - end; - -begin - - GamePath := ExtractFilePath(ParamStr(0)); - - initialize_path( LogPath , GamePath ); - initialize_path( SoundPath , GamePath + 'Sounds\' ); - initialize_path( SongPath , GamePath + 'Songs\' ); - initialize_path( ThemePath , GamePath + 'Themes\' ); - initialize_path( ScreenshotsPath , GamePath + 'Screenshots\'); - initialize_path( CoversPath , GamePath + 'Covers\' ); - initialize_path( LanguagesPath , GamePath + 'Languages\' ); - initialize_path( PluginPath , GamePath + 'Plugins\' ); - initialize_path( PlaylistPath , GamePath + 'Playlists\' ); - - DecimalSeparator := ','; -end; - -end. - +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphic, + UMusic, + URecord, + UTime, + SysUtils, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + OpenGL12, + {$IFDEF UseSerialPort} + zlportio {you can disable it and all PortWriteB calls}, + {$ENDIF} + ULCD, + ULight, + UThemes; + +type + TPlayer = record + Name: string; + + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreI: integer; + ScoreLineI: integer; + ScoreGoldenI: integer; + ScoreTotalI: integer; + + + + //SingBar Mod + ScoreLast: Real;//Last Line Score + ScorePercent: integer;//Aktual Fillstate of the SingBar + ScorePercentTarget: integer;//Target Fillstate of the SingBar + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + LineBonus_PosX: Single; + LineBonus_PosY: Single; + LineBonus_Alpha: Single; + LineBonus_Visible: boolean; + LineBonus_Text: string; + LineBonus_Color: TRGB; + LineBonus_Age: Integer; + LineBonus_Rating: Integer; + //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes + LineBonus_TargetX: integer; + LineBonus_TargetY: integer; + LineBonus_StartX: integer; + LineBonus_StartY: integer; + //PhrasenBonus - Line Bonus Mod End + + //PerfectLineTwinkle Mod (effect) + LastSentencePerfect: Boolean; + //PerfectLineTwinkle Mod end + + +// Meter: real; + + HighNut: integer; + IlNut: integer; + Nuta: array of record + Start: integer; + Dlugosc: integer; + Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute + Ton: real; + Perfect: boolean; // true if the note matches the original one, lit the star + + + + // Half size Notes Patch + Hit: boolean; // true if the note Hits the Line + //end Half size Notes Patch + + + + end; + end; + + +var + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; + + OGL: Boolean; + Done: Boolean; + Event: TSDL_event; + FileName: string; + Restart: boolean; + + // gracz i jego nuty + Player: array of TPlayer; + PlayersPlay: integer; + +procedure InitializePaths; + +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Sender: TScreenSing); +procedure NewSentence(Sender: TScreenSing); +procedure NewBeat(Sender: TScreenSing); // executed when on then new beat +procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click +procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection +//procedure NewHalf; // executed when in the half between beats +procedure NewNote(Sender: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation +uses USongs, UJoystick, math, UCommandLine; + +procedure MainLoop; +var + Delay: integer; +begin + SDL_EnableKeyRepeat(125, 125); + While not Done do + Begin + // joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // light + Light.Refresh; + + // delay + CountMidTime; +// if 1000*TimeMid > 100 then beep; + Delay := Floor(1000 / 100 - 1000 * TimeMid); + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + CountSkipTime; + + // reinitialization of graphics + if Restart then begin + Reinitialize3D; + Restart := false; + end; + + End; + UnloadOpenGL; +End; + +Procedure CheckEvents; +//var +// p: pointer; +Begin + if not Assigned(Display.NextScreen) then + While SDL_PollEvent( @event ) = 1 Do + Begin +// beep; + Case Event.type_ Of + SDL_QUITEV: begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; +{ SDL_MOUSEBUTTONDOWN: + With Event.button Do + Begin + If State = SDL_BUTTON_LEFT Then + Begin + // + End; + End; // With} + SDL_KEYDOWN: + begin + //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path + if (Event.key.keysym.sym = SDLK_SYSREQ) then + Display.ScreenShot + + // popup hack... if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + // end of popup hack + + else + begin + // check for Screen want to Exit + done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + + //If Screen wants to Exit + if done then + begin + //If Question Option is enabled then Show Exit Popup + if (Ini.AskbeforeDel = 1) then + begin + Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); + end + else //When asking for exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then + end; +// SDL_JOYAXISMOTION: +// begin +// beep +// end; + SDL_JOYBUTTONDOWN: + begin + beep + end; + End; // Case Event.type_ + End; // While +End; // CheckEvents + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(AktSong.BPM) = BPMNum then begin + // last BPM + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end else begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then begin + // there is still remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end else begin + // there is no remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +// TopBeat: real; +// TempBeat: real; +// TempTime: real; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; + + (* 2 BPMs *) +{ if Length(AktSong.BPM) > 1 then begin + (* new system *) + CurBeat := 0; + TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); + if TopBeat > AktSong.BPM[1].StartBeat then begin + // analyze second BPM + Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); + CurBeat := AktSong.BPM[1].StartBeat; + TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); + Result := CurBeat + TopBeat; + + end else begin + (* pierwszy przedzial *) + Result := TopBeat; + end; + end; // if} + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end; // if +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + Result := AktSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin + // full range + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin + // in the middle + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + +{ while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end;} + end; // if} +end; + +procedure Sing(Sender: TScreenSing); +var + Pet: integer; + PetGr: integer; + CP: integer; + Done: real; + N: integer; +begin + Czas.Teraz := Czas.Teraz + TimeSkip; + + Czas.OldBeat := Czas.AktBeat; + Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.AktBeat := Floor(Czas.MidBeat); + +// Czas.OldHalf := Czas.AktHalf; +// Czas.MidHalf := Czas.MidBeat + 0.5; +// Czas.AktHalf := Floor(Czas.MidHalf); + + Czas.OldBeatC := Czas.AktBeatC; + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); + Czas.AktBeatC := Floor(Czas.MidBeatC); + + Czas.OldBeatD := Czas.AktBeatD; + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.AktBeatD := Floor(Czas.MidBeatD); + Czas.FracBeatD := Frac(Czas.MidBeatD); + + // sentences routines + for PetGr := 0 to 0 do begin;//High(Gracz) do begin + CP := PetGr; + // ustawianie starej czesci + Czas.OldCzesc := Czesci[CP].Akt; + + // wybieranie aktualnej czesci + for Pet := 0 to Czesci[CP].High do + if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; + + // czysczenie nut gracza, gdy to jest nowa plansza + // (optymizacja raz na halfbeat jest zla) + if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); + + end; // for PetGr + + // wykonuje operacje raz na beat + if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then + NewBeat(Sender); + + // make some operations on clicks + if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then + NewBeatC(Sender); + + // make some operations when detecting new voice pitch + if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then + NewBeatD(Sender); + + // wykonuje operacje w polowie beatu +// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then +// NewHalf; + + // plynnie przesuwa text + Done := 1; + for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) + and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then + Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); + + N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; + + // wylacza ostatnia nute po przejsciu + if (Ini.LyricsEffect = 1) and (Done = 1) and + (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) + then Sender.LyricMain.Selected := -1; + + if Done > 1 then Done := 1; + Sender.LyricMain.Done := Done; + + // use Done with LCD +{ with ScreenSing do begin + if LyricMain.Selected >= 0 then begin + LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); + LCD.ShowCursor; + end; + end;} + + +end; + +procedure NewSentence(Sender: TScreenSing); +var +G: Integer; +begin + // czyszczenie nut graczy + for G := 0 to High(Player) do begin + Player[G].IlNut := 0; + Player[G].HighNut := -1; + SetLength(Player[G].Nuta, 0); + end; + + // wstawianie tekstow + with Sender do begin + LyricMain.AddCzesc(Czesci[0].Akt); + if Czesci[0].Akt < Czesci[0].High then + LyricSub.AddCzesc(Czesci[0].Akt+1) + else + LyricSub.Clear; + end; + + Sender.UpdateLCD; + + //On Sentence Change... + Sender.onSentenceChange(Czesci[0].Akt); +end; + +procedure NewBeat(Sender: TScreenSing); +var + Pet: integer; +// TempBeat: integer; +begin + // ustawia zaznaczenie tekstu +// SingScreen.LyricMain.Selected := -1; + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin + // operates on currently beated note + Sender.LyricMain.Selected := Pet; + +// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); +// LCD.ShowCursor; + + LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); + LCD.ShowCursor; + + end; +end; + +procedure NewBeatC; +var + Pet: integer; +// LPT_1: integer; +// LPT_2: integer; +begin +// LPT_1 := 1; +// LPT_2 := 1; + + // beat click + if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then + Music.PlayClick; + + // debug system on LPT + if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin + //LPT_1 := 0; +// Light.LightOne(0, 150); + + Light.LightOne(1, 200); // beat light + if ParamStr(1) = '-doublelights' then + Light.LightOne(0, 200); // beat light + + +{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then + Light.LightOne(0, 150) + else + Light.LightOne(1, 150)} + end; + + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin + // click assist + if Ini.ClickAssist = 1 then + Music.PlayClick; + + //LPT_2 := 0; + if ParamStr(1) <> '-doublelights' then + Light.LightOne(0, 150); //125 + + + // drum machine +(* TempBeat := Czas.AktBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; +// if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) + end; + + {$IFDEF UseSerialPort} + // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$ENDIF} +end; + +procedure NewBeatD(Sender: TScreenSing); +begin + NewNote(Sender); +end; + +//procedure NewHalf; +//begin +// NewNote; +//end; + +procedure NewNote(Sender: TScreenSing); +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Pet: integer; + Mozna: boolean; + Nowa: boolean; + Range: integer; + NoteHit:boolean; +begin +// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); +// beep; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do begin + + // analyze buffer + Sound[CP].AnalizujBufor; + + // adds some noise +// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; + + // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Czesci[0].Akt-1; + if SMin < 0 then SMin := 0; + SMax := Czesci[0].Akt; + + // check if we can add new note + Mozna := false; + SDet:=SMin; + for S := SMin to SMax do + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) + and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 + then begin + SDet := S; + Mozna := true; + Break; + end; + + S := SDet; + + + + + +// Czas.SzczytJest := true; +// Czas.Ton := 27; + + // gdy moze, to dodaje nute + if (Sound[CP].SzczytJest) and (Mozna) then begin + // operowanie na ostatniej nucie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + Sound[CP].Ton := Sound[CP].Ton - 12; + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + Sound[CP].Ton := Sound[CP].Ton + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin + Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + + // Half size Notes Patch + NoteHit := true; + + + if (Ini.LineBonus = 0) then + begin + // add points without LineBonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end + else + begin + // add points with Line Bonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then begin + Nowa := true; + // jezeli ostatnia ma ten sam ton + if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) + then Nowa := false; + // jezeli jest jakas nowa nuta na sprawdzanym beacie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then + Nowa := true; + + // dodawanie nowej nuty + if Nowa then begin + // nowa nuta + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNut := Player[CP].HighNut + 1; + SetLength(Player[CP].Nuta, Player[CP].IlNut); + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; + Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + + + // Half Note Patch + Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; + + + // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); + + end else begin + // przedluzenie nuty + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; + end; + + + // check for perfect note and then lit the star (on Draw) + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) + and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin + Player[CP].Nuta[Player[CP].HighNut].Perfect := true; + end; + + end;// else beep; // if S = SMax + + end; // if moze + end; // for CP +// Log.LogStatus('EndBeat', 'NewBeat'); + +//On Sentence End -> For LineBonus + SingBar +if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then +if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then + Sender.onSentenceEnd(sDet); + +end; + +procedure ClearScores(PlayerNum: integer); +begin + Player[PlayerNum].Score := 0; + Player[PlayerNum].ScoreI := 0; + Player[PlayerNum].ScoreLine := 0; + Player[PlayerNum].ScoreLineI := 0; + Player[PlayerNum].ScoreGolden := 0; + Player[PlayerNum].ScoreGoldenI := 0; + Player[PlayerNum].ScoreTotalI := 0; + + + //SingBar Mod + Player[PlayerNum].ScoreLast := 0; + Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts + Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts + //end SingBar Mod + + //PhrasenBonus - Line Bonus Mod + Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus + Player[PlayerNum].LineBonus_Alpha := 0; + Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; + Player[PlayerNum].LineBonus_TargetY := 30; + //PhrasenBonus - Line Bonus Mod End +end; + +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; + + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + begin + aPathVar := aLocation; + + If DirectoryExists(aPathVar) then + lWriteable := ForceDirectories(aPathVar) + else + lWriteable := false; + + if not lWriteable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; + +begin + + GamePath := ExtractFilePath(ParamStr(0)); + + initialize_path( LogPath , GamePath ); + initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); + initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); + initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); + initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); + initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); + initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); + initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); + initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); + + DecimalSeparator := ','; +end; + +end. + diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index be585ee1..e2e1f27e 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -1,625 +1,731 @@ -unit UMusic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses Classes, - Windows, - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - ULog, - USongs, - Bass; - -procedure InitializeSound; - -type - TSoundCard = record - Name: string; - Source: array of string; - end; - - TFFTData = array [0..256] of Single; - - TCustomSoundEntry = record - Filename: String; - Handle: hStream; - end; - - - TMusic = class - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - - - Loaded: boolean; - Loop: boolean; - public - Bass: hStream; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function Position: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal); - -end; - -const - RecordSystem = 1; - -type - TMuzyka = record - Path: string; - Start: integer; // start of song in ms - IlNut: integer; - DlugoscNut: integer; - end; - - TCzesci = record - Akt: integer; // aktualna czesc utworu do rysowania - High: integer; - Ilosc: integer; - Resolution: integer; - NotesGAP: integer; - Wartosc: integer; - Czesc: array of record - Start: integer; - StartNote: integer; - Lyric: string; - LyricWidth: real; - Koniec: integer; - BaseNote: integer; - HighNut: integer; - IlNut: integer; - TotalNotes: integer; - Nuta: array of record - Color: integer; - Start: integer; - Dlugosc: integer; - Ton: integer; - TonGamy: integer; - Tekst: string; - FreeStyle: boolean; - Wartosc: integer; // zwykla nuta x1, zlota nuta x2 - end; - end; - end; - - TCzas = record // wszystko, co dotyczy aktualnej klatki - OldBeat: integer; // poprzednio wykryty beat w utworze - AktBeat: integer; // aktualny beat w utworze - MidBeat: real; // dokladny AktBeat - - // now we use this for super synchronization! - // only used when analyzing voice - OldBeatD: integer; // poprzednio wykryty beat w utworze - AktBeatD: integer; // aktualny beat w utworze - MidBeatD: real; // dokladny AktBeatD - FracBeatD: real; // fractional part of MidBeatD - - // we use this for audiable clicks - OldBeatC: integer; // poprzednio wykryty beat w utworze - AktBeatC: integer; // aktualny beat w utworze - MidBeatC: real; // dokladny AktBeatC - FracBeatC: real; // fractional part of MidBeatC - - - OldCzesc: integer; // poprzednio wyswietlana czesc - // akt jest w czesci.akt - - Teraz: real; // aktualny czas w utworze - Razem: real; // caly czas utworu - end; - -var - Music: TMusic; - - // muzyka - Muzyka: TMuzyka; - - // czesci z nutami; - Czesci: array of TCzesci; - - // czas - Czas: TCzas; - - fHWND: Thandle; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -implementation - -uses UCommon, - UGraphic, - URecord, - UFiles, - UIni, - UMain, - UThemes; - -procedure InitializeSound; -begin - Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; - Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; -end; - -procedure TMusic.InitializePlayback; -var - Pet: integer; - S: integer; -begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - fHWND := AllocateHWND( nil); // TODO : JB - can we do something different here ?? lazarus didnt like this function - - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - Log.LogStatus('Loading Sounds', 'Music Initialize'); - - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TMusic.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TMusic.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -end; - -procedure TMusic.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - //Set Volume - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TMusic.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TMusic.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then begin - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TMusic.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TMusic.MoveTo(Time: real); -var - bytes: integer; -begin - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TMusic.Play; -begin - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; -end; - -procedure TMusic.Pause; //Pause Mod -begin - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; -end; - -procedure TMusic.Stop; -begin - Bass_ChannelStop(Bass); -end; - -procedure TMusic.Close; -begin - Bass_StreamFree(Bass); -end; - -function TMusic.Length: real; -var - bytes: integer; -begin - Result := 60; - - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); -end; - -function TMusic.Position: real; -var - bytes: integer; -begin - Result := 0; - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -end; - -function TMusic.Finished: boolean; -begin - Result := false; - - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -end; - -procedure TMusic.PlayStart; -begin - BASS_ChannelPlay(BassStart, True); -end; - -procedure TMusic.PlayBack; -begin - BASS_ChannelPlay(BassBack, True);// then -end; - -procedure TMusic.PlaySwoosh; -begin - BASS_ChannelPlay(BassSwoosh, True); -end; - -procedure TMusic.PlayChange; -begin - BASS_ChannelPlay(BassChange, True); -end; - -procedure TMusic.PlayOption; -begin - BASS_ChannelPlay(BassOption, True); -end; - -procedure TMusic.PlayClick; -begin - BASS_ChannelPlay(BassClick, True); -end; - -procedure TMusic.PlayDrum; -begin - BASS_ChannelPlay(BassDrum, True); -end; - -procedure TMusic.PlayHihat; -begin - BASS_ChannelPlay(BassHihat, True); -end; - -procedure TMusic.PlayClap; -begin - BASS_ChannelPlay(BassClap, True); -end; - -procedure TMusic.PlayShuffle; -begin - BASS_ChannelPlay(BassShuffle, True); -end; - -procedure TMusic.StopShuffle; -begin - BASS_ChannelStop(BassShuffle); -end; - -procedure TMusic.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; -end; - -procedure TMusic.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; - -end; - -//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - if not BASS_RecordInit(RecordI) then begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; -end; - -procedure TMusic.StopCard(Card: byte); -begin - BASS_RecordSetDevice(Card); - BASS_RecordFree; -end; - -function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TMusic.GetFFTData: TFFTData; -var -Data: TFFTData; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - //Result := Data; -end; - -function TMusic.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TMusic.PlayCustomSound(const Index: Cardinal); -begin -if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); -end; - - -end. +unit UMusic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + UCommon, + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + {$IFDEF useBASS} + bass, + {$ENDIF} + ULog, + USongs; + + +procedure InitializeSound; + +type + TSoundCard = record + Name: string; + Source: array of string; + end; + + TFFTData = array [0..256] of Single; + + TCustomSoundEntry = record + Filename : String; + Handle : hStream; + end; + + + TMusic = class + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + + + Loaded: boolean; + Loop: boolean; + public + Bass: hStream; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal); + +end; + +const + RecordSystem = 1; + +type + TMuzyka = record + Path: string; + Start: integer; // start of song in ms + IlNut: integer; + DlugoscNut: integer; + end; + + TCzesci = record + Akt: integer; // aktualna czesc utworu do rysowania + High: integer; + Ilosc: integer; + Resolution: integer; + NotesGAP: integer; + Wartosc: integer; + Czesc: array of record + Start: integer; + StartNote: integer; + Lyric: string; + LyricWidth: real; + Koniec: integer; + BaseNote: integer; + HighNut: integer; + IlNut: integer; + TotalNotes: integer; + Nuta: array of record + Color: integer; + Start: integer; + Dlugosc: integer; + Ton: integer; + TonGamy: integer; + Tekst: string; + FreeStyle: boolean; + Wartosc: integer; // zwykla nuta x1, zlota nuta x2 + end; + end; + end; + + TCzas = record // wszystko, co dotyczy aktualnej klatki + OldBeat: integer; // poprzednio wykryty beat w utworze + AktBeat: integer; // aktualny beat w utworze + MidBeat: real; // dokladny AktBeat + + // now we use this for super synchronization! + // only used when analyzing voice + OldBeatD: integer; // poprzednio wykryty beat w utworze + AktBeatD: integer; // aktualny beat w utworze + MidBeatD: real; // dokladny AktBeatD + FracBeatD: real; // fractional part of MidBeatD + + // we use this for audiable clicks + OldBeatC: integer; // poprzednio wykryty beat w utworze + AktBeatC: integer; // aktualny beat w utworze + MidBeatC: real; // dokladny AktBeatC + FracBeatC: real; // fractional part of MidBeatC + + + OldCzesc: integer; // poprzednio wyswietlana czesc + // akt jest w czesci.akt + + Teraz: real; // aktualny czas w utworze + Razem: real; // caly czas utworu + end; + +var + Music: TMusic; + + // muzyka + Muzyka: TMuzyka; + + // czesci z nutami; + Czesci: array of TCzesci; + + // czas + Czas: TCzas; + + fHWND: Thandle; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + UGraphic, + URecord, + UFiles, + UIni, + UMain, + UThemes; + +procedure InitializeSound; +begin + Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; + Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; +end; + +procedure TMusic.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + {$ENDIF} + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TMusic.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TMusic.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); + {$ENDIF} +end; + +procedure TMusic.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + //Set Volume + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + {$ENDIF} +end; + +procedure TMusic.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TMusic.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + {$ENDIF} + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TMusic.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TMusic.MoveTo(Time: real); +var + bytes: integer; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); + {$ENDIF} +end; + +procedure TMusic.Play; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; + {$ENDIF} +end; + +procedure TMusic.Pause; //Pause Mod +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; + {$ENDIF} +end; + +procedure TMusic.Stop; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); + {$ENDIF} +end; + +procedure TMusic.Close; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); + {$ENDIF} +end; + +function TMusic.Length: real; +var + bytes: integer; +begin + Result := 60; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); + {$ENDIF} +end; + +function TMusic.Position: real; +var + bytes: integer; +begin + Result := 0; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); + {$ENDIF} +end; + +function TMusic.Finished: boolean; +begin + Result := false; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; + {$ENDIF} +end; + +procedure TMusic.PlayStart; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); + {$ENDIF} +end; + +procedure TMusic.PlayBack; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then + {$ENDIF} +end; + +procedure TMusic.PlaySwoosh; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); + {$ENDIF} +end; + +procedure TMusic.PlayChange; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); + {$ENDIF} +end; + +procedure TMusic.PlayOption; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); + {$ENDIF} +end; + +procedure TMusic.PlayClick; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); + {$ENDIF} +end; + +procedure TMusic.PlayDrum; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); + {$ENDIF} +end; + +procedure TMusic.PlayHihat; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); + {$ENDIF} +end; + +procedure TMusic.PlayClap; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); + {$ENDIF} +end; + +procedure TMusic.PlayShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); + {$ENDIF} +end; + +procedure TMusic.StopShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); + {$ENDIF} +end; + +procedure TMusic.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TMusic.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if not BASS_RecordInit(RecordI) then begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; + + {$ENDIF} +end; + +procedure TMusic.StopCard(Card: byte); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; + {$ENDIF} +end; + +function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + {$ENDIF} + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end else begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TMusic.GetFFTData: TFFTData; +var +Data: TFFTData; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + //Result := Data; + + {$ENDIF} +end; + +function TMusic.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TMusic.PlayCustomSound(const Index: Cardinal); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); + + {$ENDIF} +end; + + +end. diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 03c87a35..d22e20d3 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -1,347 +1,359 @@ -unit URecord; - -interface - -uses Classes, - Math, - SysUtils, - UMusic, - UIni, - BASS; - -type - TSound = class - BufferNew: TMemoryStream; // buffer for newest sample - BufferArray: array[1..4096] of smallint; // (Signal) newest 4096 samples - BufferLong: array of TMemoryStream; // full buffer - - Num: integer; - n: integer; // length of Signal to analyze - - // pitch detection - SzczytJest: boolean; // czy jest szczyt - Szczyt: integer; // pozycja szczytu na osi poziomej - TonDokl: real; // ton aktualnego szczytu - Ton: integer; // ton bez ulamka - TonGamy: integer; // ton w gamie. wartosci: 0-11 - Skala: real; // skala FFT - - // procedures - procedure ProcessNewBuffer; - procedure AnalizujBufor; // use to analyze sound from buffers to get new pitch - procedure AnalizujByAutocorrelation; // we call it to analyze sound by checking Autocorrelation - function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation - end; - - TSoundCardInput = record - Name: string; - end; - - TSoundCard = record - // here can be the soundcard information - whole database from which user will select recording source - Description: string; - Input: array of TSoundCardInput; - InputSelected: integer; - MicInput: Integer; - - // bass record - BassRecordStream: hStream; - end; - - TRecord = class - SoundCard: array of TSoundCard; - constructor Create; - end; - - smallintarray = array [0..maxInt shr 1-1] of smallInt; - psmallintarray = ^smallintarray; - - // procedures - bass record - function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; - - -var - Sound: array of TSound; - SoundCard: array of TSoundCard; - Poz: integer; - Recording: TRecord; - -implementation -uses UMain; - -procedure TSound.ProcessNewBuffer; -var - S: integer; - L: integer; - A: integer; -begin - // process BufferArray - S := 0; - L := BufferNew.Size div 2; - if L > n then begin - S := L - n; - L := n; - end; - - // copy to array - for A := L+1 to n do - BufferArray[A-L] := BufferArray[A]; - - BufferNew.Seek(2*S, soBeginning); - BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L); - - // process BufferLong - if Ini.SavePlayback = 1 then - begin - BufferNew.Seek(0, soBeginning); - BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); - end; -end; - -procedure TSound.AnalizujBufor; -begin - AnalizujByAutocorrelation; -end; - -procedure TSound.AnalizujByAutocorrelation; -var - T: integer; // tone - F: real; // freq - Wages: array[0..35] of real; // wages - MaxT: integer; // max tone - MaxW: real; // max wage - V: real; // volume - MaxV: real; // max volume - S: integer; // Signal - Threshold: real; // threshold -begin - SzczytJest := false; - - // find maximum volume of first 1024 words of signal - MaxV := 0; - for S := 1 to 1024 do // 0.5.2: fix. was from 0 to 1023 - begin - V := Abs(BufferArray[S]) / $10000; - - if V > MaxV then - MaxV := V; - end; - - // prepare to analyze - MaxW := 0; - - // analyze all 12 halftones - for T := 0 to 35 do // to 11, then 23, now 35 (for Whitney and my high voice) - begin - F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81 - Wages[T] := AnalyzeAutocorrelationFreq(F); - - if Wages[T] > MaxW then - begin // this frequency has better wage - MaxW := Wages[T]; - MaxT := T; - end; - end; // for T - - Threshold := 0.1; - case Ini.Threshold of - 0: Threshold := 0.05; - 1: Threshold := 0.1; - 2: Threshold := 0.15; - 3: Threshold := 0.2; - end; - - if MaxV >= Threshold then - begin // found acceptable volume // 0.1 - SzczytJest := true; - TonGamy := MaxT mod 12; - Ton := MaxT mod 12; - end; - -end; - -function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference -var - Count: real; - Src: integer; - Dst: integer; - Move: integer; - Il: integer; // how many counts were done -begin - // we use Signal as source - Count := 0; - Il := 0; - Src := 1; - Move := Round(44100/Freq); - Dst := Src + Move; - - // ver 2 - compare in vertical - while (Dst < n) do - begin // process up to n (4KB) of Signal - Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000; - Inc(Src); - Inc(Dst); - Inc(Il); - end; - - Result := 1 - Count / Il; -end; - -function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; -var - L: integer; - S: integer; - PB: pbytearray; - PSI: psmallintarray; - I: integer; - Skip: integer; - P1: integer; - P2: integer; - Boost: byte; -begin - // set boost - case Ini.MicBoost of - 0: Boost := 1; - 1: Boost := 2; - 2: Boost := 4; - 3: Boost := 8; - end; - - // boost buffer - L := Len div 2; // number of samples - PSI := Buffer; - for S := 0 to L-1 do - begin - I := PSI^[S] * Boost; - if I > 32767 then I := 32767; // 0.5.0: limit - if I < -32768 then I := -32768; // 0.5.0: limit - PSI^[S] := I; - end; - - // decode user - P1 := (user and 255) - 1; - P2 := (user div 256) - 1; - - - // 2 players USB mic, left channel - if P1 >= 0 then - begin - L := Len div 4; // number of samples - PB := Buffer; - - Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting - for S := 1 to L do - begin - Sound[P1].BufferNew.Write(PB[(S-1)*4], 2); - end; - Sound[P1].ProcessNewBuffer; - end; - - // 2 players USB mic, right channel - Skip := 2; - - if P2 >= 0 then - begin - L := Len div 4; // number of samples - PB := Buffer; - Sound[P2].BufferNew.Clear; - for S := 1 to L do - begin - Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2); - end; - Sound[P2].ProcessNewBuffer; - end; - - Result := true; -end; - -constructor TRecord.Create; -var - SC: integer; // soundcard - SCI: integer; // soundcard input - Descr: string; - InputName: PChar; - Flags: integer; - No: integer; - - function isDuplicate(Desc: String): Boolean; - var - I: Integer; - begin - Result := False; - //Check for Soundcard with same Description - For I := 0 to SC-1 do - begin - if (SoundCard[I].Description = Desc) then - begin - Result := True; - Break; - end; - end; - end; - -begin - // checks for recording devices and puts them into array; - SetLength(SoundCard, 0); - - SC := 0; - Descr := BASS_RecordGetDeviceDescription(SC); - - while (Descr <> '') do - begin - - //If there is another SoundCard with the Same ID, Search an available Name - if (IsDuplicate(Descr)) then - begin - No:= 1; //Count of SoundCards with same Name - Repeat - Inc(No) - Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - - //Set Description - Descr := Descr + ' (' + InttoStr(No) + ')'; - end; - - SetLength(SoundCard, SC+1); - - SoundCard[SC].Description := Descr; - - //Get Recording Inputs - SCI := 0; - BASS_RecordInit(SC); - - InputName := BASS_RecordGetInputName(SCI); - - SetLength(SoundCard[SC].Input, 1); - SoundCard[SC].Input[SCI].Name := InputName; - - // process each input - while (InputName <> nil) do - begin - Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then - begin - SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; - end; - - //Set Mic Index - if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then - SoundCard[SC].MicInput := SCI; - - Inc(SCI); - InputName := BASS_RecordGetInputName(SCI); - end; - - BASS_RecordFree; - - Inc(SC); - Descr := BASS_RecordGetDeviceDescription(SC); - end; // while -end; - - -end. - - - +unit URecord; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses Classes, + Math, + SysUtils, + {$IFDEF useBASS} + bass, + {$ENDIF} + UCommon, + UMusic, + UIni; + +type + TSound = class + BufferNew: TMemoryStream; // buffer for newest sample + BufferArray: array[1..4096] of smallint; // (Signal) newest 4096 samples + BufferLong: array of TMemoryStream; // full buffer + + Num: integer; + n: integer; // length of Signal to analyze + + // pitch detection + SzczytJest: boolean; // czy jest szczyt + Szczyt: integer; // pozycja szczytu na osi poziomej + TonDokl: real; // ton aktualnego szczytu + Ton: integer; // ton bez ulamka + TonGamy: integer; // ton w gamie. wartosci: 0-11 + Skala: real; // skala FFT + + // procedures + procedure ProcessNewBuffer; + procedure AnalizujBufor; // use to analyze sound from buffers to get new pitch + procedure AnalizujByAutocorrelation; // we call it to analyze sound by checking Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation + end; + + TSoundCardInput = record + Name: string; + end; + + TSoundCard = record + // here can be the soundcard information - whole database from which user will select recording source + Description: string; + Input: array of TSoundCardInput; + InputSelected: integer; + MicInput: Integer; + + // bass record + BassRecordStream: hStream; + end; + + TRecord = class + SoundCard: array of TSoundCard; + constructor Create; + end; + + smallintarray = array [0..maxInt shr 1-1] of smallInt; + psmallintarray = ^smallintarray; + + // procedures - bass record + function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; + + +var + Sound: array of TSound; + SoundCard: array of TSoundCard; + Poz: integer; + Recording: TRecord; + +implementation +uses UMain; + +procedure TSound.ProcessNewBuffer; +var + S: integer; + L: integer; + A: integer; +begin + // process BufferArray + S := 0; + L := BufferNew.Size div 2; + if L > n then begin + S := L - n; + L := n; + end; + + // copy to array + for A := L+1 to n do + BufferArray[A-L] := BufferArray[A]; + + BufferNew.Seek(2*S, soBeginning); + BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L); + + // process BufferLong + if Ini.SavePlayback = 1 then + begin + BufferNew.Seek(0, soBeginning); + BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); + end; +end; + +procedure TSound.AnalizujBufor; +begin + AnalizujByAutocorrelation; +end; + +procedure TSound.AnalizujByAutocorrelation; +var + T: integer; // tone + F: real; // freq + Wages: array[0..35] of real; // wages + MaxT: integer; // max tone + MaxW: real; // max wage + V: real; // volume + MaxV: real; // max volume + S: integer; // Signal + Threshold: real; // threshold +begin + SzczytJest := false; + + // find maximum volume of first 1024 words of signal + MaxV := 0; + for S := 1 to 1024 do // 0.5.2: fix. was from 0 to 1023 + begin + V := Abs(BufferArray[S]) / $10000; + + if V > MaxV then + MaxV := V; + end; + + // prepare to analyze + MaxW := 0; + + // analyze all 12 halftones + for T := 0 to 35 do // to 11, then 23, now 35 (for Whitney and my high voice) + begin + F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81 + Wages[T] := AnalyzeAutocorrelationFreq(F); + + if Wages[T] > MaxW then + begin // this frequency has better wage + MaxW := Wages[T]; + MaxT := T; + end; + end; // for T + + Threshold := 0.1; + case Ini.Threshold of + 0: Threshold := 0.05; + 1: Threshold := 0.1; + 2: Threshold := 0.15; + 3: Threshold := 0.2; + end; + + if MaxV >= Threshold then + begin // found acceptable volume // 0.1 + SzczytJest := true; + TonGamy := MaxT mod 12; + Ton := MaxT mod 12; + end; + +end; + +function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference +var + Count: real; + Src: integer; + Dst: integer; + Move: integer; + Il: integer; // how many counts were done +begin + // we use Signal as source + Count := 0; + Il := 0; + Src := 1; + Move := Round(44100/Freq); + Dst := Src + Move; + + // ver 2 - compare in vertical + while (Dst < n) do + begin // process up to n (4KB) of Signal + Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000; + Inc(Src); + Inc(Dst); + Inc(Il); + end; + + Result := 1 - Count / Il; +end; + +function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; +var + L: integer; + S: integer; + PB: pbytearray; + PSI: psmallintarray; + I: integer; + Skip: integer; + P1: integer; + P2: integer; + Boost: byte; +begin + // set boost + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + end; + + // boost buffer + L := Len div 2; // number of samples + PSI := Buffer; + for S := 0 to L-1 do + begin + I := PSI^[S] * Boost; + if I > 32767 then I := 32767; // 0.5.0: limit + if I < -32768 then I := -32768; // 0.5.0: limit + PSI^[S] := I; + end; + + // decode user + P1 := (user and 255) - 1; + P2 := (user div 256) - 1; + + + // 2 players USB mic, left channel + if P1 >= 0 then + begin + L := Len div 4; // number of samples + PB := Buffer; + + Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting + for S := 1 to L do + begin + Sound[P1].BufferNew.Write(PB[(S-1)*4], 2); + end; + Sound[P1].ProcessNewBuffer; + end; + + // 2 players USB mic, right channel + Skip := 2; + + if P2 >= 0 then + begin + L := Len div 4; // number of samples + PB := Buffer; + Sound[P2].BufferNew.Clear; + for S := 1 to L do + begin + Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2); + end; + Sound[P2].ProcessNewBuffer; + end; + + Result := true; +end; + +constructor TRecord.Create; +var + SC: integer; // soundcard + SCI: integer; // soundcard input + Descr: string; + InputName: PChar; + Flags: integer; + No: integer; + + function isDuplicate(Desc: String): Boolean; + var + I: Integer; + begin + Result := False; + //Check for Soundcard with same Description + For I := 0 to SC-1 do + begin + if (SoundCard[I].Description = Desc) then + begin + Result := True; + Break; + end; + end; + end; + +begin + // TODO : JB_linux - Reimplement recording, without bass for linux + {$IFDEF useBASS} + // checks for recording devices and puts them into array; + SetLength(SoundCard, 0); + + SC := 0; + Descr := BASS_RecordGetDeviceDescription(SC); + + while (Descr <> '') do + begin + + //If there is another SoundCard with the Same ID, Search an available Name + if (IsDuplicate(Descr)) then + begin + No:= 1; //Count of SoundCards with same Name + Repeat + Inc(No) + Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + + //Set Description + Descr := Descr + ' (' + InttoStr(No) + ')'; + end; + + SetLength(SoundCard, SC+1); + + SoundCard[SC].Description := Descr; + + //Get Recording Inputs + SCI := 0; + BASS_RecordInit(SC); + + InputName := BASS_RecordGetInputName(SCI); + + SetLength(SoundCard[SC].Input, 1); + SoundCard[SC].Input[SCI].Name := InputName; + + // process each input + while (InputName <> nil) do + begin + Flags := BASS_RecordGetInput(SCI); + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then + begin + SetLength(SoundCard[SC].Input, SCI+1); + SoundCard[SC].Input[SCI].Name := InputName; + end; + + //Set Mic Index + if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then + SoundCard[SC].MicInput := SCI; + + Inc(SCI); + InputName := BASS_RecordGetInputName(SCI); + end; + + BASS_RecordFree; + + Inc(SC); + Descr := BASS_RecordGetDeviceDescription(SC); + end; // while + {$ENDIF} +end; + + +end. + + + diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 7f0b85c0..1bc4c558 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1028 +1,1043 @@ -unit UTexture; - -// Plain (alpha = 1) -// Transparent -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - Windows, - Math, - Classes, - SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - Graphics, - JPEG, - PNGImage, - {$ENDIF} - UCommon, - UThemes; - - -procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - end; - -var - lasthue: double; - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - - TexOrigW: integer; - TexOrigH: integer; - TexNewW: integer; - TexNewH: integer; - - TexFitW: integer; - TexFitH: integer; // new for limit - - TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) - TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) - TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) - TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - - -implementation -uses ULog, DateUtils, UCovers, StrUtils; - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - // find texture entry - T := FindTexture(Name); - - if T = -1 then begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin - // load texture - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - - end; - - if FromCache and Covers.CoverExists(Name) then begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -// expects: src, dst: pointers to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0] := src[0]/255; - clr[1] := src[1]/255; - clr[2] := src[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=src[3]; - end; -end; - -// expects: src: $rrggbb -// dst: pointer to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0]:=((src shr 16) and $ff)/255; - clr[1]:=((src shr 8) and $ff)/255; - clr[2]:=(src and $ff)/255; - //calculate luminance and saturation from rgb - hls[1]:=maxvalue(clr); //l:=... - delta:=hls[1]-minvalue(clr); - if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=255; - end; -end; -//returns hue within range [0.0-6.0) -function col2h(Color:Cardinal):double; -var - clr,hls: array[0..2] of double; - delta: double; -begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; -end; - - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - Res: TResourceStream; - TextureB: TBitmap; - TextureJ: TJPEGImage; - {$IFNDEF FPC} - TexturePNG: TPNGObject; - {$ENDIF} - - TextureAlpha: array of byte; - AlphaPtr: PByte; - TransparentColor: TColor; - PixelColor: TColor; - - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; - SkipX: integer; - myAlpha: Real; - myRGBABitmap: array of byte; - RGBPtr: PByte; - myHue: Double; -begin - {$IFNDEF FPC} // TODO : JB eeeew this is a nasty one... - // but lazarus implementation scanlines is different :( - // need to implement as per - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 - // http://wiki.lazarus.freepascal.org/Developing_with_Graphics - Log.BenchmarkStart(4); - Mipmapping := true; - - if FromRegistry then begin - try - Res := TResourceStream.Create(HInstance, Identifier, Format); - except - beep; - Exit; - end; - end; - - // filetype "detection" - if (not FromRegistry) and (FileExists(Identifier)) then begin - Format:=''; - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - end; -// else Format:='JPG'; -// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; - - if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; - - if Format = 'BMP' then - begin - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end - else - if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end - else if Format = 'PNG' then - begin - {$IFNDEF FPC} - // TODO : JB - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TexturePNG); - // transparent png hack start (part 1 of 2) - if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then - begin - setlength(TextureAlpha, TextureB.Width*TextureB.Height); - setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); - if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or - (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then - begin - // i would have preferred english variables here but i use Position because i'm lazy - for Position := 0 to TextureB.Height - 1 do - begin - AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); - RGBPtr:=PByte(TexturePNG.Scanline[Position]); - for Position2 := 0 to TextureB.Width - 1 do - begin - TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; - MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; -// Inc(RGBPtr); - Inc(AlphaPtr); - end; - end; - end; - end else - setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) - // transparent png hack end - TexturePNG.Free; - {$ENDIF} - end; - - if FromRegistry then Res.Free; - - if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver - Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); - Result.TexNum := -1; - end else begin - - glGenTextures(1, ActTex); - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - if Typ = 'Plain' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - - // copy and process pixeldata - TextureB.PixelFormat := pf24bit; -{ if (TextureB.PixelFormat = pf8bit) then begin - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD24[Position*TexNewW + Position2+1, 1] := Pix; - TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - end; - end; - end;} - if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - end else begin - // limit - TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrigH; - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, - Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time - - TexNewW := Limit; - TexNewH := Limit; - TexOrigW := Limit; - TexOrigH := Limit; - end; - - // creating cache mipmap - if CreateCacheMipmap then begin - if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin - // texture only uses some of it's space. there's a need for resize to fit full size - // and get best quality - TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrigH; - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; - TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; - TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - - end else begin - // texture fits perfectly - gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - end; - end; - - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Error > 0 then beep; - end - end; - - if Typ = 'Transparent' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - // ,- part of transparent png hack - if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) - TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; - end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; - TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; - end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); - TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); - TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); - TextureD32[Position*TexNewW + Position2+1, 4] := 255; - end; - end; - end; - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - -// The new awesomeness of colorized pngs starts here -// We're the first who had this feature, so give credit when you copy+paste :P - if Typ = 'Colorized' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - myHue:=col2h(Col); - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then - ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue) - else - ColorizeCopy(Pix, - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue); - end; - end; - - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -// eoa COLORIZE - - if Typ = 'Transparent Range' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - - if Typ = 'Font' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Outline' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Outline 2' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - - if Typ = 'Arrow' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - TextureB.Free; - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Identifier; - - end; - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - end; // logerror - {$ENDIF} -end; - -{procedure ResizeTexture(s: pbytearray; d: pbytearray); -var - Position: integer; - Position2: integer; -begin - for Position := 0 to TexNewH*4-1 do - for Position2 := 0 to TexNewW-1 do - d[Position*TexNewW + Position2] := 0; - - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; - d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; - d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; - d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; - end; - end; -end;} - -{procedure SetTexture(p: pointer); -begin - glGenTextures(1, Tekstur); - glBindTexture(GL_TEXTURE_2D, Tekstur); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); -end;} - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg - -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -end. +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFDEF FPC} + ulazjpeg, + {$ELSE} + JPEG, + PNGImage, + {$ENDIF} + Graphics, + UCommon, + UThemes; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + {$ENDIF} + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + lasthue: double; + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + + TexOrigW: integer; + TexOrigH: integer; + TexNewW: integer; + TexNewH: integer; + + TexFitW: integer; + TexFitH: integer; // new for limit + + TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) + TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) + TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) + TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers, StrUtils; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + // find texture entry + T := FindTexture(Name); + + if T = -1 then begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin + // load texture + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + + end; + + if FromCache and Covers.CoverExists(Name) then begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +// expects: src, dst: pointers to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0] := src[0]/255; + clr[1] := src[1]/255; + clr[2] := src[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=src[3]; + end; +end; + +// expects: src: $rrggbb +// dst: pointer to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0]:=((src shr 16) and $ff)/255; + clr[1]:=((src shr 8) and $ff)/255; + clr[2]:=(src and $ff)/255; + //calculate luminance and saturation from rgb + hls[1]:=maxvalue(clr); //l:=... + delta:=hls[1]-minvalue(clr); + if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=255; + end; +end; +//returns hue within range [0.0-6.0) +function col2h(Color:Cardinal):double; +var + clr,hls: array[0..2] of double; + delta: double; +begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; +end; + + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + Res: TResourceStream; + TextureB: TBitmap; + TextureJ: TJPEGImage; + {$IFNDEF FPC} + TexturePNG: TPNGObject; + {$ENDIF} + + TextureAlpha: array of byte; + AlphaPtr: PByte; + TransparentColor: TColor; + PixelColor: TColor; + + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; + SkipX: integer; + myAlpha: Real; + myRGBABitmap: array of byte; + RGBPtr: PByte; + myHue: Double; +begin + {$IFNDEF FPC} // TODO : JB_lazarus eeeew this is a nasty one... + // but lazarus implementation scanlines is different :( + // need to implement as per + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 + // http://wiki.lazarus.freepascal.org/Developing_with_Graphics + Log.BenchmarkStart(4); + Mipmapping := true; + + if FromRegistry then begin + try + Res := TResourceStream.Create(HInstance, Identifier, Format); + except + beep; + Exit; + end; + end; + + // filetype "detection" + if (not FromRegistry) and (FileExists(Identifier)) then begin + Format:=''; + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + end; +// else Format:='JPG'; +// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; + + if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin + TextureB := TBitmap.Create; + + if Format = 'BMP' then + begin + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); + end + else + if Format = 'JPG' then + begin + TextureJ := TJPEGImage.Create; + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TextureJ); + TextureJ.Free; + end + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus - fix this for lazarus.. + TexturePNG := TPNGObject.Create; + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TexturePNG); + // transparent png hack start (part 1 of 2) + if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then + begin + setlength(TextureAlpha, TextureB.Width*TextureB.Height); + setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); + if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or + (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then + begin + // i would have preferred english variables here but i use Position because i'm lazy + for Position := 0 to TextureB.Height - 1 do + begin + AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); + RGBPtr:=PByte(TexturePNG.Scanline[Position]); + for Position2 := 0 to TextureB.Width - 1 do + begin + TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; + MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; +// Inc(RGBPtr); + Inc(AlphaPtr); + end; + end; + end; + end else + setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) + // transparent png hack end + TexturePNG.Free; + {$ENDIF} + end; + + if FromRegistry then Res.Free; + + if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver + Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Result.TexNum := -1; + end else begin + + glGenTextures(1, ActTex); + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + if Typ = 'Plain' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + + // copy and process pixeldata + TextureB.PixelFormat := pf24bit; +{ if (TextureB.PixelFormat = pf8bit) then begin + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD24[Position*TexNewW + Position2+1, 1] := Pix; + TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + end; + end; + end;} + if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin + if (TextureB.PixelFormat = pf24bit) then begin + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; + end; + end; + end; + end else begin + // limit + TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrigH; + if (TextureB.PixelFormat = pf24bit) then begin + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; + end; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, + Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time + + TexNewW := Limit; + TexNewH := Limit; + TexOrigW := Limit; + TexOrigH := Limit; + end; + + // creating cache mipmap + if CreateCacheMipmap then begin + if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin + // texture only uses some of it's space. there's a need for resize to fit full size + // and get best quality + TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage + SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image + + TexFitH := TexOrigH; + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; + TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; + TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + + end else begin + // texture fits perfectly + gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + end; + end; + + glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Error > 0 then beep; + end + end; + + if Typ = 'Transparent' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + // ,- part of transparent png hack + if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) + TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; + end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; + TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; + TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; + TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; + TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; + end else begin + TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); + TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); + TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); + TextureD32[Position*TexNewW + Position2+1, 4] := 255; + end; + end; + end; + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + +// The new awesomeness of colorized pngs starts here +// We're the first who had this feature, so give credit when you copy+paste :P + if Typ = 'Colorized' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + + myHue:=col2h(Col); + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then + ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue) + else + ColorizeCopy(Pix, + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue); + end; + end; + + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +// eoa COLORIZE + + if Typ = 'Transparent Range' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Font' then begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Outline' then begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Outline 2' then begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Arrow' then begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + TextureB.Free; + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Identifier; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + end; // logerror + {$ENDIF} +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Position: integer; + Position2: integer; +begin + for Position := 0 to TexNewH*4-1 do + for Position2 := 0 to TexNewW-1 do + d[Position*TexNewW + Position2] := 0; + + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; + d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; + d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; + d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +begin + glGenTextures(1, Tekstur); + glBindTexture(GL_TEXTURE_2D, Tekstur); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); +end;} + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg + +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index 29e972ae..87d4f922 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -1,81 +1,131 @@ -unit UTime; - -interface - -type - TTime = class - constructor Create; - function GetTime: real; - end; - -procedure CountSkipTimeSet; -procedure CountSkipTime; -procedure CountMidTime; -procedure TimeSleep(ms: real); - -var - USTime: TTime; - - TimeFreq: int64; - TimeNew: int64; - TimeOld: int64; - TimeSkip: real; - TimeMid: real; - TimeMidTemp: int64; - -implementation - -uses Windows; - -constructor TTime.Create; -begin - CountSkipTimeSet; -end; - -procedure CountSkipTimeSet; -begin - QueryPerformanceFrequency(TimeFreq); - QueryPerformanceCounter(TimeNew); -end; - -procedure CountSkipTime; -begin - TimeOld := TimeNew; - QueryPerformanceCounter(TimeNew); - TimeSkip := (TimeNew-TimeOld)/TimeFreq; -end; - -procedure CountMidTime; -begin - QueryPerformanceCounter(TimeMidTemp); - TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; -end; - -procedure TimeSleep(ms: real); -var - TimeStart: int64; - TimeHalf: int64; - Time: real; - Stop: boolean; -begin - QueryPerformanceCounter(TimeStart); - - Stop := false; - while (not Stop) do begin - QueryPerformanceCounter(TimeHalf); - Time := 1000 * (TimeHalf-TimeStart)/TimeFreq; - if Time > ms then Stop := true; - end; - -end; - -function TTime.GetTime: real; -var - TimeTemp: int64; -begin - QueryPerformanceCounter(TimeTemp); - Result := TimeTemp/TimeFreq; -end; - - -end. +unit UTime; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +type + TTime = class + constructor Create; + function GetTime: real; + end; + +procedure CountSkipTimeSet; +procedure CountSkipTime; +procedure CountMidTime; +procedure TimeSleep(ms: real); + +var + USTime: TTime; + + TimeFreq: int64; + TimeNew: int64; + TimeOld: int64; + TimeSkip: real; + TimeMid: real; + TimeMidTemp: int64; + +implementation + +uses + {$IFDEF win32} + windows, + {$ELSE} + libc, + time, + {$ENDIF} + ucommon; + + +// -- ON Linux it MAY Be better to use ... clock_gettime() instead of CurrentSec100OfDay +// who knows how fast or slow that function is ! +// but this gets a compile for now .. :) + +constructor TTime.Create; +begin + CountSkipTimeSet; +end; + +procedure CountSkipTimeSet; +begin + {$IFDEF win32} + QueryPerformanceFrequency(TimeFreq); + QueryPerformanceCounter(TimeNew); + {$ELSE} + TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + TimeFreq := 0; + {$ENDIF} +end; + +procedure CountSkipTime; +begin + TimeOld := TimeNew; + + {$IFDEF win32} + QueryPerformanceCounter(TimeNew); + {$ELSE} + TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + {$ENDIF} + + TimeSkip := (TimeNew-TimeOld)/TimeFreq; +end; + +procedure CountMidTime; +begin + {$IFDEF win32} + QueryPerformanceCounter(TimeMidTemp); + TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; + {$ELSE} + TimeMidTemp := CurrentSec100OfDay(); + TimeMid := (TimeMidTemp-TimeNew); // TODO - JB_Linux will prob need looking at + {$ENDIF} +end; + +procedure TimeSleep(ms: real); +var + TimeStart: int64; + TimeHalf: int64; + Time: real; + Stop: boolean; +begin + {$IFDEF win32} + QueryPerformanceCounter(TimeStart); + {$ELSE} + TimeStart := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + {$ENDIF} + + + Stop := false; + while (not Stop) do + begin + {$IFDEF win32} + QueryPerformanceCounter(TimeHalf); + Time := 1000 * (TimeHalf-TimeStart)/TimeFreq; + {$ELSE} + TimeHalf := CurrentSec100OfDay(); + Time := 1000 * (TimeHalf-TimeStart); // TODO - JB_Linux will prob need looking at + {$ENDIF} + + if Time > ms then + Stop := true; + end; + +end; + +function TTime.GetTime: real; +var + TimeTemp: int64; +begin + {$IFDEF win32} + QueryPerformanceCounter(TimeTemp); + Result := TimeTemp / TimeFreq; + {$ELSE} + TimeTemp := CurrentSec100OfDay(); + Result := TimeTemp; // TODO - JB_Linux will prob need looking at + {$ENDIF} +end; + + +end. -- cgit v1.2.3 From 0a0728b1bc280ed0e2e932b4d8f3b3b151aa62a8 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 06:51:40 +0000 Subject: fixed a bunch of path delimiter issues on linux build :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@411 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDLLManager.pas | 10 +- Game/Code/Classes/UIni.pas | 1552 ++++++++++++++++++------------------- Game/Code/Classes/USkins.pas | 328 ++++---- Game/Code/Classes/USongs.pas | 1506 +++++++++++++++++------------------ 4 files changed, 1698 insertions(+), 1698 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index d25efb35..ff6c16a4 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -42,11 +42,11 @@ var DLLMan: TDLLMan; const + DLLPath = 'Plugins'; + {$IFDEF win32} - DLLPath = 'Plugins\'; DLLExt = '.dll'; {$ELSE} - DLLPath = 'Plugins/'; DLLExt = '.so'; {$ENDIF} @@ -73,7 +73,7 @@ var SR: TSearchRec; begin - if FindFirst(DLLPath + '*' + DLLExt, faAnyFile , SR) = 0 then + if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then begin repeat SetLength(Plugins, Length(Plugins)+1); @@ -143,7 +143,7 @@ begin exit; } //Load Libary - hLibg := LoadLibrary(PChar(DLLPath + Filename)); + hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename)); //If Loaded if (hLibg <> 0) then begin @@ -170,7 +170,7 @@ function TDLLMan.LoadPlugin(No: Cardinal): boolean; begin Result := False; //Load Libary - hLib := LoadLibrary(PChar(DLLPath + PluginPaths[No])); + hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No])); //If Loaded if (hLib <> 0) then begin diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index cd5c3716..86ce7361 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -1,776 +1,776 @@ -unit UIni; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses IniFiles, ULog, SysUtils; - -type - TIni = class - Name: array[0..11] of string; - - // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; - - //Filename of the opened iniFile - Filename: string; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - Threshold: integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - - // Record - Card: integer; // not saved in config.ini - - CardList: array of record - Name: string; - Input: integer; - ChannelL: integer; - ChannelR: integer; - end; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskbeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - - // Soundcards - SoundCard: array[0..7, 1..2] of integer; - - // Devices - LPT: integer; - - procedure Load; - procedure Save; - procedure SaveNames; - procedure SaveLevel; - end; - - -var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - ICard: array of string; - IInput: array of string; - -const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); - - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; - - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ISingWindow: array[0..1] of string = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); - //IOscilloscope: array[0..1] of string = ('Off', 'On'); - - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - - - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array [0..1] of String =('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); - - IJoypad: array[0..1] of string = ('Off', 'On'); - ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); - - IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); - -implementation - -uses //UFiles, - UMain, - SDL, - ULanguage, - USkins, - URecord, - UCommandLine; - -procedure TIni.Load; -var - IniFile: TMemIniFile; - ThemeIni: TMemIniFile; - Tekst: string; - Pet: integer; - B: boolean; - I, I2, I3: integer; - S: string; - Modes: PPSDL_Rect; - SR: TSearchRec; //Skin List Patch - - function GetFileName (S: String):String; - begin - //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); - Result := copy (S,0,Pos ('.ini',S)-1); - end; - -begin - GamePath := ExtractFilePath(ParamStr(0)); - - if (Params.ConfigFile <> '') then - try - IniFile := TMemIniFile.Create(Params.ConfigFile); - except - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - end - else - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - - - // Name - for I := 0 to 11 do - Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - - // Templates for Names Mod - for I := 0 to 2 do - Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); - for Pet := 0 to High(IPlayers) do - if Tekst = IPlayers[Pet] then Ini.Players := Pet; - - // Difficulty - Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); - for Pet := 0 to High(IDifficulty) do - if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; - - // Language - Tekst := IniFile.ReadString('Game', 'Language', 'English'); - for Pet := 0 to High(ILanguage) do - if Tekst = ILanguage[Pet] then Ini.Language := Pet; - -// Language.ChangeLanguage(ILanguage[Ini.Language]); - - // Tabs - Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); - for Pet := 0 to High(ITabs) do - if Tekst = ITabs[Pet] then Ini.Tabs := Pet; - - //Tabs at Startup fix - Ini.Tabs_at_startup := Ini.Tabs; - - // Sorting - Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); - for Pet := 0 to High(ISorting) do - if Tekst = ISorting[Pet] then Ini.Sorting := Pet; - - // Debug - Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); - for Pet := 0 to High(IDebug) do - if Tekst = IDebug[Pet] then Ini.Debug := Pet; - - //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; - - // Screens - Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); - for Pet := 0 to High(IScreens) do - if Tekst = IScreens[Pet] then Ini.Screens := Pet; - - // Resolution - SetLength(IResolution, 0); - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - repeat -// Log.LogError(Format( ' %d x %d', [ modes^.w, modes^.h ] ) ); - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - until Modes^ = nil; - - // reverse order - for I := 0 to (Length(IResolution) div 2) - 1 do begin - S := IResolution[I]; - IResolution[I] := IResolution[High(IResolution)-I]; - IResolution[High(IResolution)-I] := S; - end; - - Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - for Pet := 0 to High(IResolution) do - if Tekst = IResolution[Pet] then Ini.Resolution := Pet; - - // FullScreen - Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); - for Pet := 0 to High(IFullScreen) do - if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; - - // Resolution - Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); - for Pet := 0 to High(IDepth) do - if Tekst = IDepth[Pet] then Ini.Depth := Pet; - - // Texture Size - Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); - for Pet := 0 to High(ITextureSize) do - if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; - - // SingWindow - Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); - for Pet := 0 to High(ISingWindow) do - if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; - - // Oscilloscope - Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); - for Pet := 0 to High(IOscilloscope) do - if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; - - // Spectrum - Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); - for Pet := 0 to High(ISpectrum) do - if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; - - // Spectrograph - Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); - for Pet := 0 to High(ISpectrograph) do - if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; - - // MovieSize - Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); - for Pet := 0 to High(IMovieSize) do - if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; - - // MicBoost - Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); - for Pet := 0 to High(IMicBoost) do - if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; - - // ClickAssist - Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); - for Pet := 0 to High(IClickAssist) do - if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; - - // BeatClick - Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); - for Pet := 0 to High(IBeatClick) do - if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; - - // SavePlayback - Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); - for Pet := 0 to High(ISavePlayback) do - if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; - - // Threshold - Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); - for Pet := 0 to High(IThreshold) do - if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; - - //Song Preview - Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); - for Pet := 0 to High(IPreviewVolume) do - if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; - - Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); - for Pet := 0 to High(IPreviewFading) do - if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; - - // Lyrics Font - Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); - for Pet := 0 to High(ILyricsFont) do - if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; - - // Lyrics Effect - Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); - for Pet := 0 to High(ILyricsEffect) do - if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; - - // Solmization - Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); - for Pet := 0 to High(ISolmization) do - if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; - - // Theme - - //Theme List Patch - - //I2 Saves the no of the Deluxe (Standard-) Theme - I2 := 0; - //I counts is the cur. Theme no - I := 0; - - SetLength(ITheme, 0); - FindFirst('Themes\*.ini',faAnyFile,SR); - Repeat - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SR.Name); - Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); - ThemeIni.Free; - - //if Deluxe Theme then save Themeno to I2 - if (Tekst = 'DELUXE') then - I2 := I; - - //Search for Skins for this Theme - for Pet := low(Skin.Skin) to high(Skin.Skin) do - begin - if UpperCase(Skin.Skin[Pet].Theme) = Tekst then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := GetFileName(SR.Name); - break; - end; - end; - - Inc(I); - Until FindNext(SR) <> 0; - FindClose(SR); - //Theme List Patch End } - - //No Theme Found - if (Length(ITheme)=0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - - Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); - Ini.Theme := 0; - for Pet := 0 to High(ITheme) do - if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; - - // Skin - Skin.onThemeChange; - Ini.SkinNo := 0; - - Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); - for Pet := 0 to High(ISkin) do - if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; - - // Color - Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); - for Pet := 0 to High(IColor) do - if Tekst = IColor[Pet] then Ini.Color := Pet; - - // Record - load ini list - SetLength(CardList, 0); - I := 1; - while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin - //Automatically Delete not Existing Sound Cards - S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); - //{ - B := False; - //Look for Soundcard - for I2 := 0 to High(Recording.SoundCard) do - begin - if (S = Trim(Recording.SoundCard[I2].Description)) then - begin - B := True; - Break; - end; - end; - - if B then - begin //} - I3 := Length(CardList); - SetLength(CardList, I3+1); - Ini.CardList[I3].Name := S; - Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); - Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); - Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); - end; - Inc(I); - end; - - // Record - append detected soundcards - for I := 0 to High(Recording.SoundCard) do - begin - B := False; - For I2 := 0 to High(CardList) do - begin //Search for Card in List - if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then - begin - B := True; - Break; - end; - end; - - //If not in List -> Add - If not B then - begin - I3 := Length(CardList); - SetLength(CardList, I3+1); - CardList[I3].Name := Trim(Recording.SoundCard[I].Description); - CardList[I3].Input := 0; - CardList[I3].ChannelL := 0; - CardList[I3].ChannelR := 0; - // default for new users - if (Length(CardList) = 1) then - CardList[I].ChannelL := 1; - end; - end; - - //Advanced Settings - - // LoadAnimation - Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); - for Pet := 0 to High(ILoadAnimation) do - if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; - - // ScreenFade - Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); - for Pet := 0 to High(IScreenFade) do - if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; - - // EffectSing - Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); - for Pet := 0 to High(IEffectSing) do - if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; - - // AskbeforeDel - Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); - for Pet := 0 to High(IAskbeforeDel) do - if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; - - // OnSongClick - Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); - for Pet := 0 to High(IOnSongClick) do - if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; - - // Linebonus - Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); - for Pet := 0 to High(ILineBonus) do - if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - - // PartyPopup - Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); - for Pet := 0 to High(IPartyPopup) do - if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; - - - // Joypad - Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); - for Pet := 0 to High(IJoypad) do - if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - - // LCD - Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); - for Pet := 0 to High(ILPT) do - if Tekst = ILPT[Pet] then Ini.LPT := Pet; - - - // SongPath - if (Params.SongPath <> '') then - SongPath := IncludeTrailingPathDelimiter(Params.SongPath) - else - SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); - - Filename := IniFile.FileName; - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; - Tekst: string; - I: Integer; - S: String; -begin - //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin - if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin - - IniFile := TIniFile.Create(Filename); - - // Players - Tekst := IPlayers[Ini.Players]; - IniFile.WriteString('Game', 'Players', Tekst); - - // Difficulty - Tekst := IDifficulty[Ini.Difficulty]; - IniFile.WriteString('Game', 'Difficulty', Tekst); - - // Language - Tekst := ILanguage[Ini.Language]; - IniFile.WriteString('Game', 'Language', Tekst); - - // Tabs - Tekst := ITabs[Ini.Tabs]; - IniFile.WriteString('Game', 'Tabs', Tekst); - - // Sorting - Tekst := ISorting[Ini.Sorting]; - IniFile.WriteString('Game', 'Sorting', Tekst); - - // Debug - Tekst := IDebug[Ini.Debug]; - IniFile.WriteString('Game', 'Debug', Tekst); - - // Screens - Tekst := IScreens[Ini.Screens]; - IniFile.WriteString('Graphics', 'Screens', Tekst); - - // FullScreen - Tekst := IFullScreen[Ini.FullScreen]; - IniFile.WriteString('Graphics', 'FullScreen', Tekst); - - // Resolution - Tekst := IResolution[Ini.Resolution]; - IniFile.WriteString('Graphics', 'Resolution', Tekst); - - // Depth - Tekst := IDepth[Ini.Depth]; - IniFile.WriteString('Graphics', 'Depth', Tekst); - - // Resolution - Tekst := ITextureSize[Ini.TextureSize]; - IniFile.WriteString('Graphics', 'TextureSize', Tekst); - - // Sing Window - Tekst := ISingWindow[Ini.SingWindow]; - IniFile.WriteString('Graphics', 'SingWindow', Tekst); - - // Oscilloscope - Tekst := IOscilloscope[Ini.Oscilloscope]; - IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - - // Spectrum - Tekst := ISpectrum[Ini.Spectrum]; - IniFile.WriteString('Graphics', 'Spectrum', Tekst); - - // Spectrograph - Tekst := ISpectrograph[Ini.Spectrograph]; - IniFile.WriteString('Graphics', 'Spectrograph', Tekst); - - // Movie Size - Tekst := IMovieSize[Ini.MovieSize]; - IniFile.WriteString('Graphics', 'MovieSize', Tekst); - - // MicBoost - Tekst := IMicBoost[Ini.MicBoost]; - IniFile.WriteString('Sound', 'MicBoost', Tekst); - - // ClickAssist - Tekst := IClickAssist[Ini.ClickAssist]; - IniFile.WriteString('Sound', 'ClickAssist', Tekst); - - // BeatClick - Tekst := IBeatClick[Ini.BeatClick]; - IniFile.WriteString('Sound', 'BeatClick', Tekst); - - // Threshold - Tekst := IThreshold[Ini.Threshold]; - IniFile.WriteString('Sound', 'Threshold', Tekst); - - // Song Preview - Tekst := IPreviewVolume[Ini.PreviewVolume]; - IniFile.WriteString('Sound', 'PreviewVolume', Tekst); - - Tekst := IPreviewFading[Ini.PreviewFading]; - IniFile.WriteString('Sound', 'PreviewFading', Tekst); - - // SavePlayback - Tekst := ISavePlayback[Ini.SavePlayback]; - IniFile.WriteString('Sound', 'SavePlayback', Tekst); - - // Lyrics Font - Tekst := ILyricsFont[Ini.LyricsFont]; - IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); - - // Lyrics Effect - Tekst := ILyricsEffect[Ini.LyricsEffect]; - IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); - - // Solmization - Tekst := ISolmization[Ini.Solmization]; - IniFile.WriteString('Lyrics', 'Solmization', Tekst); - - // Theme - Tekst := ITheme[Ini.Theme]; - IniFile.WriteString('Themes', 'Theme', Tekst); - - // Skin - Tekst := ISkin[Ini.SkinNo]; - IniFile.WriteString('Themes', 'Skin', Tekst); - - // Color - Tekst := IColor[Ini.Color]; - IniFile.WriteString('Themes', 'Color', Tekst); - - // Record - for I := 0 to High(CardList) do begin - S := IntToStr(I+1); - - Tekst := CardList[I].Name; - IniFile.WriteString('Record', 'DeviceName' + S, Tekst); - - Tekst := IntToStr(CardList[I].Input); - IniFile.WriteString('Record', 'Input' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelL); - IniFile.WriteString('Record', 'ChannelL' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelR); - IniFile.WriteString('Record', 'ChannelR' + S, Tekst); - end; - - //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); - - //Advanced Settings - - //LoadAnimation - Tekst := ILoadAnimation[Ini.LoadAnimation]; - IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - - //EffectSing - Tekst := IEffectSing[Ini.EffectSing]; - IniFile.WriteString('Advanced', 'EffectSing', Tekst); - - //ScreenFade - Tekst := IScreenFade[Ini.ScreenFade]; - IniFile.WriteString('Advanced', 'ScreenFade', Tekst); - - //AskbeforeDel - Tekst := IAskbeforeDel[Ini.AskbeforeDel]; - IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); - - //OnSongClick - Tekst := IOnSongClick[Ini.OnSongClick]; - IniFile.WriteString('Advanced', 'OnSongClick', Tekst); - - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Advanced', 'LineBonus', Tekst); - - //Party Popup - Tekst := IPartyPopup[Ini.PartyPopup]; - IniFile.WriteString('Advanced', 'PartyPopup', Tekst); - - // Joypad - Tekst := IJoypad[Ini.Joypad]; - IniFile.WriteString('Controller', 'Joypad', Tekst); - - IniFile.Free; - end; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - //Name - // Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); - - IniFile.Free; - end; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); - - IniFile.Free; - end; -end; - -end. +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses IniFiles, ULog, SysUtils; + +type + TIni = class + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + Threshold: integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + + // Record + Card: integer; // not saved in config.ini + + CardList: array of record + Name: string; + Input: integer; + ChannelL: integer; + ChannelR: integer; + end; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskbeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + // Soundcards + SoundCard: array[0..7, 1..2] of integer; + + // Devices + LPT: integer; + + procedure Load; + procedure Save; + procedure SaveNames; + procedure SaveLevel; + end; + + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + ICard: array of string; + IInput: array of string; + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); + //IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array [0..1] of String =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); + + IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); + +implementation + +uses //UFiles, + UMain, + SDL, + ULanguage, + USkins, + URecord, + UCommandLine; + +procedure TIni.Load; +var + IniFile: TMemIniFile; + ThemeIni: TMemIniFile; + Tekst: string; + Pet: integer; + B: boolean; + I, I2, I3: integer; + S: string; + Modes: PPSDL_Rect; + SR: TSearchRec; //Skin List Patch + + function GetFileName (S: String):String; + begin + //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); + Result := copy (S,0,Pos ('.ini',S)-1); + end; + +begin + GamePath := ExtractFilePath(ParamStr(0)); + + if (Params.ConfigFile <> '') then + try + IniFile := TMemIniFile.Create(Params.ConfigFile); + except + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + end + else + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + + // Name + for I := 0 to 11 do + Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + + // Templates for Names Mod + for I := 0 to 2 do + Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); + for Pet := 0 to High(IPlayers) do + if Tekst = IPlayers[Pet] then Ini.Players := Pet; + + // Difficulty + Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); + for Pet := 0 to High(IDifficulty) do + if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; + + // Language + Tekst := IniFile.ReadString('Game', 'Language', 'English'); + for Pet := 0 to High(ILanguage) do + if Tekst = ILanguage[Pet] then Ini.Language := Pet; + +// Language.ChangeLanguage(ILanguage[Ini.Language]); + + // Tabs + Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); + for Pet := 0 to High(ITabs) do + if Tekst = ITabs[Pet] then Ini.Tabs := Pet; + + //Tabs at Startup fix + Ini.Tabs_at_startup := Ini.Tabs; + + // Sorting + Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); + for Pet := 0 to High(ISorting) do + if Tekst = ISorting[Pet] then Ini.Sorting := Pet; + + // Debug + Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); + for Pet := 0 to High(IDebug) do + if Tekst = IDebug[Pet] then Ini.Debug := Pet; + + //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; + + // Screens + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + for Pet := 0 to High(IScreens) do + if Tekst = IScreens[Pet] then Ini.Screens := Pet; + + // Resolution + SetLength(IResolution, 0); + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + repeat +// Log.LogError(Format( ' %d x %d', [ modes^.w, modes^.h ] ) ); + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + until Modes^ = nil; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do begin + S := IResolution[I]; + IResolution[I] := IResolution[High(IResolution)-I]; + IResolution[High(IResolution)-I] := S; + end; + + Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + for Pet := 0 to High(IResolution) do + if Tekst = IResolution[Pet] then Ini.Resolution := Pet; + + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + // Resolution + Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); + for Pet := 0 to High(IDepth) do + if Tekst = IDepth[Pet] then Ini.Depth := Pet; + + // Texture Size + Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); + for Pet := 0 to High(ITextureSize) do + if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; + + // SingWindow + Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); + for Pet := 0 to High(ISingWindow) do + if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; + + // Oscilloscope + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); + for Pet := 0 to High(IOscilloscope) do + if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; + + // Spectrum + Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); + for Pet := 0 to High(ISpectrum) do + if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; + + // Spectrograph + Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); + for Pet := 0 to High(ISpectrograph) do + if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; + + // MovieSize + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); + for Pet := 0 to High(IMovieSize) do + if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; + + // MicBoost + Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); + for Pet := 0 to High(IMicBoost) do + if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; + + // ClickAssist + Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); + for Pet := 0 to High(IClickAssist) do + if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; + + // BeatClick + Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); + for Pet := 0 to High(IBeatClick) do + if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; + + // SavePlayback + Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); + for Pet := 0 to High(ISavePlayback) do + if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; + + // Threshold + Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); + for Pet := 0 to High(IThreshold) do + if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + + //Song Preview + Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); + for Pet := 0 to High(IPreviewVolume) do + if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; + + Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); + for Pet := 0 to High(IPreviewFading) do + if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; + + // Lyrics Font + Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); + for Pet := 0 to High(ILyricsFont) do + if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; + + // Lyrics Effect + Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); + for Pet := 0 to High(ILyricsEffect) do + if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; + + // Solmization + Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); + for Pet := 0 to High(ISolmization) do + if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; + + // Theme + + //Theme List Patch + + //I2 Saves the no of the Deluxe (Standard-) Theme + I2 := 0; + //I counts is the cur. Theme no + I := 0; + + SetLength(ITheme, 0); + FindFirst('Themes' + PathDelim + '*.ini',faAnyFile,SR); + Repeat + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SR.Name); + Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); + ThemeIni.Free; + + //if Deluxe Theme then save Themeno to I2 + if (Tekst = 'DELUXE') then + I2 := I; + + //Search for Skins for this Theme + for Pet := low(Skin.Skin) to high(Skin.Skin) do + begin + if UpperCase(Skin.Skin[Pet].Theme) = Tekst then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := GetFileName(SR.Name); + break; + end; + end; + + Inc(I); + Until FindNext(SR) <> 0; + FindClose(SR); + //Theme List Patch End } + + //No Theme Found + if (Length(ITheme)=0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); + Ini.Theme := 0; + for Pet := 0 to High(ITheme) do + if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; + + // Skin + Skin.onThemeChange; + Ini.SkinNo := 0; + + Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); + for Pet := 0 to High(ISkin) do + if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; + + // Color + Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); + for Pet := 0 to High(IColor) do + if Tekst = IColor[Pet] then Ini.Color := Pet; + + // Record - load ini list + SetLength(CardList, 0); + I := 1; + while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin + //Automatically Delete not Existing Sound Cards + S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); + //{ + B := False; + //Look for Soundcard + for I2 := 0 to High(Recording.SoundCard) do + begin + if (S = Trim(Recording.SoundCard[I2].Description)) then + begin + B := True; + Break; + end; + end; + + if B then + begin //} + I3 := Length(CardList); + SetLength(CardList, I3+1); + Ini.CardList[I3].Name := S; + Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); + Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); + Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); + end; + Inc(I); + end; + + // Record - append detected soundcards + for I := 0 to High(Recording.SoundCard) do + begin + B := False; + For I2 := 0 to High(CardList) do + begin //Search for Card in List + if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then + begin + B := True; + Break; + end; + end; + + //If not in List -> Add + If not B then + begin + I3 := Length(CardList); + SetLength(CardList, I3+1); + CardList[I3].Name := Trim(Recording.SoundCard[I].Description); + CardList[I3].Input := 0; + CardList[I3].ChannelL := 0; + CardList[I3].ChannelR := 0; + // default for new users + if (Length(CardList) = 1) then + CardList[I].ChannelL := 1; + end; + end; + + //Advanced Settings + + // LoadAnimation + Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); + for Pet := 0 to High(ILoadAnimation) do + if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; + + // ScreenFade + Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); + for Pet := 0 to High(IScreenFade) do + if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; + + // EffectSing + Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); + for Pet := 0 to High(IEffectSing) do + if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; + + // AskbeforeDel + Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); + for Pet := 0 to High(IAskbeforeDel) do + if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; + + // OnSongClick + Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); + for Pet := 0 to High(IOnSongClick) do + if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; + + // Linebonus + Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + + // PartyPopup + Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); + for Pet := 0 to High(IPartyPopup) do + if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; + + + // Joypad + Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); + for Pet := 0 to High(IJoypad) do + if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; + + // LCD + Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); + for Pet := 0 to High(ILPT) do + if Tekst = ILPT[Pet] then Ini.LPT := Pet; + + + // SongPath + if (Params.SongPath <> '') then + SongPath := IncludeTrailingPathDelimiter(Params.SongPath) + else + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + + Filename := IniFile.FileName; + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; + Tekst: string; + I: Integer; + S: String; +begin + //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin + + IniFile := TIniFile.Create(Filename); + + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); + + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); + + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); + + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); + + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); + + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); + + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); + + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); + + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); + + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); + + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); + + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); + + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); + + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); + + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); + + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); + + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); + + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); + + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); + + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); + + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); + + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); + + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); + + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); + + // Record + for I := 0 to High(CardList) do begin + S := IntToStr(I+1); + + Tekst := CardList[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + + Tekst := IntToStr(CardList[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelL); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelR); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; + + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + + //Advanced Settings + + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); + + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); + + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); + + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); + + IniFile.Free; + end; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + //Name + // Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); + + IniFile.Free; + end; +end; + +end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index a5f618ff..a825050f 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -1,164 +1,164 @@ -unit USkins; - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -interface - -type - TSkinTexture = record - Name: string; - FileName: string; - end; - - TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet - end; - - TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; - constructor Create; - procedure LoadList; - procedure ParseDir(Dir: string); - procedure LoadHeader(FileName: string); - procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): string; - function GetSkinNumber(Name: string): integer; - procedure onThemeChange; - end; - -var - Skin: TSkin; - -implementation - -uses IniFiles, Classes, SysUtils, ULog, UIni; - -constructor TSkin.Create; -begin - LoadList; -// LoadSkin('Lisek'); -// SkinColor := Color; -end; - -procedure TSkin.LoadList; -var - SR: TSearchRec; -// SR2: TSearchRec; -// SLen: integer; -begin - if FindFirst('Skins\*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir('Skins\' + SR.Name + '\'); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); -end; - -procedure TSkin.ParseDir(Dir: string); -var - SR: TSearchRec; -// SLen: integer; -begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - LoadHeader(Dir + SR.Name); - //Log.LogError(SR.Name); - until FindNext(SR) <> 0; - end; -end; - -procedure TSkin.LoadHeader(FileName: string); -var - SkinIni: TMemIniFile; - S: integer; -begin - SkinIni := TMemIniFile.Create(FileName); - - S := Length(Skin); - SetLength(Skin, S+1); - Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); - Skin[S].FileName := ExtractFileName(FileName); - Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); - Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); - Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); - - SkinIni.Free; -end; - -procedure TSkin.LoadSkin(Name: string); -var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; -begin - S := GetSkinNumber(Name); - SkinPath := Skin[S].Path; - - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); - - SL := TStringList.Create; - SkinIni.ReadSection('Textures', SL); - - SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do begin - SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); - end; - - SL.Free; - SkinIni.Free; -end; - -function TSkin.GetTextureFileName(TextureName: string): string; -var - T: integer; -begin - Result := ''; - for T := 0 to High(SkinTexture) do - if SkinTexture[T].Name = TextureName then Result := SkinPath + SkinTexture[T].FileName; - -{ Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} -end; - -function TSkin.GetSkinNumber(Name: string): integer; -var - S: integer; -begin - Result := 0; // set default to the first available skin - for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; -end; - -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; -begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; - end; - -end; - -end. +unit USkins; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +interface + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, Classes, SysUtils, ULog, UIni; + +constructor TSkin.Create; +begin + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; +// SR2: TSearchRec; +// SLen: integer; +begin + if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir('Skins'+PathDelim + SR.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; +// SLen: integer; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + //Log.LogError(SR.Name); + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + for T := 0 to High(SkinTexture) do + if SkinTexture[T].Name = TextureName then Result := SkinPath + SkinTexture[T].FileName; + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + Ini.SkinNo:=0; + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index f5afbee2..301eb15c 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,753 +1,753 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -uses SysUtils, ULog, UTexture, UCatCovers; - -type - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: string; - Score: integer; - Length: string; - end; - - TSong = record - Path: string; - Folder: string; // for sorting by folder - FileName: string; - - // sorting methods - Category: array of string; // I think I won't need this - Genre: string; - Edition: string; - Language: string; // 0.5.0: new - - Title: string; - Artist: string; - - Text: string; - Creator: string; - - Cover: string; - CoverTex: TTexture; - Mp3: string; - Background: string; - Video: string; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - - TSongs = class - private - BrowsePos: Cardinal; //Actual Pos in Song Array - public - Song: array of TSong; // array of songs - Selected: integer; // selected song index - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: string); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: string): string; - end; - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) - -implementation - -uses StrUtils, - UFiles, - UMain, - UIni; - - -procedure TSongs.LoadSongList; -begin - Log.LogStatus('Initializing', 'LoadSongList'); - - // clear - Setlength(Song, 50); - - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); -// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); -end; - -procedure TSongs.BrowseDir(Dir: string); -var - SR: TSearchRec; // for parsing Songs Directory - SLen: integer; -begin - if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Dir + Sr.Name + '\'); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - if FindFirst(Dir + '*.txt', 0, SR) = 0 then begin -// Log.LogStatus('Parsing file: ' + Dir + SR.Name + '\' + SRD.Name, 'LoadSongList'); - repeat - //New Mod for better Memory Management - - SLen := BrowsePos; - {//Old - SLen := Length(Song); - SetLength(Song, SLen + 1);//} - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos('\', Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) - else begin - // scanning complete, file is good - // if there is no cover then try to find it - if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); -// if Song[SLen].Background = '' then begin -// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); -// end; // no needed here} - - // fix by adding path. no, don't fix it. -// if Song[SLen].Cover <> '' then -// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNext(SR) <> 0; - end; // if FindFirst - FindClose(SR); -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: string): string; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := Low(Songs.Song) to High(Songs.Song) do begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := Songs.Song[S].Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := Songs.Song[S].Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := Songs.Song[S].Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Title[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Artist[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := Songs.Song[S].Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := Songs.Song[S]; - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +uses SysUtils, ULog, UTexture, UCatCovers; + +type + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: string; + Score: integer; + Length: string; + end; + + TSong = record + Path: string; + Folder: string; // for sorting by folder + FileName: string; + + // sorting methods + Category: array of string; // I think I won't need this + Genre: string; + Edition: string; + Language: string; // 0.5.0: new + + Title: string; + Artist: string; + + Text: string; + Creator: string; + + Cover: string; + CoverTex: TTexture; + Mp3: string; + Background: string; + Video: string; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class + private + BrowsePos: Cardinal; //Actual Pos in Song Array + public + Song: array of TSong; // array of songs + Selected: integer; // selected song index + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: string); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: string): string; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +implementation + +uses StrUtils, + UFiles, + UMain, + UIni; + + +procedure TSongs.LoadSongList; +begin + Log.LogStatus('Initializing', 'LoadSongList'); + + // clear + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); +// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); +end; + +procedure TSongs.BrowseDir(Dir: string); +var + SR: TSearchRec; // for parsing Songs Directory + SLen: integer; +begin + if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Dir + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + if FindFirst(Dir + '*.txt', 0, SR) = 0 then begin +// Log.LogStatus('Parsing file: ' + Dir + SR.Name + '\' + SRD.Name, 'LoadSongList'); + repeat + //New Mod for better Memory Management + + SLen := BrowsePos; + {//Old + SLen := Length(Song); + SetLength(Song, SLen + 1);//} + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) + else begin + // scanning complete, file is good + // if there is no cover then try to find it + if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); +// if Song[SLen].Background = '' then begin +// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); +// end; // no needed here} + + // fix by adding path. no, don't fix it. +// if Song[SLen].Cover <> '' then +// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNext(SR) <> 0; + end; // if FindFirst + FindClose(SR); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: string): string; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Title[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Artist[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +end. -- cgit v1.2.3 From 26d8c209beba866f111a9d047bf1a70fe245b75d Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 20 Sep 2007 07:19:45 +0000 Subject: new lyrics stuff; it's broken (lyrics don't show) and in "debug" mode (weird stuff going on in the singscreen) but i'm tired of editing conflicts git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@412 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 3167 ++++++++++++++++++++-------------------- Game/Code/Classes/UGraphic.pas | 1222 ++++++++-------- Game/Code/Classes/ULyrics.pas | 777 ++++++---- Game/Code/Classes/UMain.pas | 1588 ++++++++++---------- Game/Code/Classes/UMusic.pas | 1466 +++++++++---------- Game/Code/Classes/UThemes.pas | 4 + 6 files changed, 4192 insertions(+), 4032 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index ef1f2709..4c5d2ce0 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,1583 +1,1584 @@ -unit UDraw; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -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; NrCzesci: integer); -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); - -// TimeBar -procedure SingDrawTimeBar(); - -// The Singbar -procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); - -//Phrasen Bonus - Line Bonus -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); - -//Draw Editor NoteLines -procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} - windows, - {$ELSE} - lclintf, - {$ENDIF} - OpenGL12, - 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 >= 1 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 - Pet: integer; -begin; -// Log.LogStatus('Oscilloscope', 'SingDraw'); - glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - - glBegin(GL_LINE_STRIP); - glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); - for Pet := 2 to Sound[NrSound].n div 1 do begin - glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), - -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); - end; - glEnd; -end; - -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -var - Pet: integer; -begin - glEnable(GL_BLEND); - glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); - glBegin(GL_LINES); - for Pet := 0 to 9 do begin - glVertex2f(Left, Top + Pet * Space); - glVertex2f(Right, Top + Pet * Space); - end; - glEnd; - glDisable(GL_BLEND); -end; - -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); -var - Pet: integer; - TempR: real; -begin - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - glEnable(GL_BLEND); - glBegin(GL_LINES); - for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin - if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then - glColor4f(0, 0, 0, 1) - else - glColor4f(0, 0, 0, 0.3); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); - end; - glEnd; - glDisable(GL_BLEND); -end; - -// draw blank Notebars -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: integer; - TempR: real; - R,G,B: real; - - PlayerNumber: Integer; - - GoldenStarPos : real; -begin -// We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero -// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 - NrCzesci := 0; - -// exploit done - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - - - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case Wartosc of - 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - 2: 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 == ende, schluss - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge - - 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -var - TempR: real; - Rec: TRecR; - N: integer; - R: real; - G: real; - B: real; - 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].IlNut > 0 then - begin - TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); - for N := 0 to Player[NrGracza].HighNut do - begin - with Player[NrGracza].Nuta[N] do - begin - // Left part of note - Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; - - // draw the left part - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; - - // (nowe) - dunno - if (Start+Dlugosc-1 = Czas.AktBeatD) then - Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); - if not (Start+Dlugosc-1 = Czas.AktBeatD) then - - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - end; - end; // with - end; // for - // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit - // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ - - // passing on NrGracza... hope this is really something like the player-number, not only - // some kind of weird index into a colour-table - - if (Ini.EffectSing=1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); - end; // if -end; - -//draw Note glow -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); -var - Rec: TRecR; - Pet: integer; - TempR: real; - R,G,B: real; - X1, X2, X3, X4: real; - W, H: real; -begin - if (Player[NrGracza].ScoreTotalI >= 0) then begin - glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - // begin: 14, 20 - // easy: 6, 11 - W := NotesW * 2 + 2; - H := NotesH * 1.5 + 3.5; - - X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie - X1 := X2-W; - - X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie - X4 := X3+W; - - // left - Rec.Left := X1; - Rec.Right := X2; - Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; - Rec.Bottom := Rec.Top + 2 * H; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 - Pet: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; - NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - LyricTemp: string; - PetCz: integer; - - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - -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 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; - - // rysuje tekst - new Lyric engine - ScreenSing.LyricMain.Draw; - ScreenSing.LyricSub.Draw; - - // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * -// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 - - //SingBar Mod - //modded again to make it moveable: it's working, so why try harder - else if Ini.Oscilloscope = 2 then - begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; - end; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - if Ini.LineBonus > 0 then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // shift position of the pop up (if not dead) - end; // loop - for all players - end; // if - linebonus - - - if PlayersPlay = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; - end; - //PhrasenBonus - Line Bonus Mod 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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes - end; - - if (PlayersPlay = 2) then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(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; - - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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 - Pet: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; - NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - LyricTemp: string; - PetCz: integer; - - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - -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; - - // Lyric engine - ScreenSingModi.LyricMain.Draw; - ScreenSingModi.LyricSub.Draw; - - // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 - - //SingBar Mod - // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores - else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; - end; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // pop up still visible, has not reached it's position - move it - end; // loop through all players - end; // if it's time to draw them - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; - end; -//PhrasenBonus - Line Bonus Mod 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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); - end; - - if (PlayersPlay = 2) then begin - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - end; - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - end; - - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - end; - - if PlayerInfo.Playerinfo[2].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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: -// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - - // Golden Note Patch - case Wartosc of - 0: glColor4f(1, 1, 1, 0.35); - 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 0.3, 0.85); - end; // case - - - - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; -begin - x := Theme.Sing.StaticTimeProgress.x; - y := Theme.Sing.StaticTimeProgress.y; - width:= Theme.Sing.StaticTimeProgress.w; - height:= Theme.Sing.StaticTimeProgress.h; - - glColor4f(Theme.Sing.StaticTimeProgress.ColR, - Theme.Sing.StaticTimeProgress.ColG, - Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - - glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(x,y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); - glTexCoord2f(0, 1); glVertex2f(x, y+height); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1,1,1,1); -end; - -end. - +unit UDraw; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +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; NrCzesci: integer); +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +// The Singbar +procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); + +//Phrasen Bonus - Line Bonus +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); + +//Draw Editor NoteLines +procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGL12, + 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 >= 1 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 + Pet: integer; +begin; +// Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } + + glBegin(GL_LINE_STRIP); + glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + for Pet := 2 to Sound[NrSound].n div 1 do begin + glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), + -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + end; + glEnd; +end; + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Pet: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Pet := 0 to 9 do begin + glVertex2f(Left, Top + Pet * Space); + glVertex2f(Right, Top + Pet * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +var + Pet: integer; + TempR: real; +begin + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin + if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + + PlayerNumber: Integer; + + GoldenStarPos : real; +begin +// We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero +// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 + NrCzesci := 0; + +// exploit done + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case Wartosc of + 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + 2: 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 == ende, schluss + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge + + 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R: real; + G: real; + B: real; + 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].IlNut > 0 then + begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do + begin + with Player[NrGracza].Nuta[N] do + begin + // Left part of note + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; // with + end; // for + // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit + // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + + // passing on NrGracza... hope this is really something like the player-number, not only + // some kind of weird index into a colour-table + + if (Ini.EffectSing=1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; +begin + if (Player[NrGracza].ScoreTotalI >= 0) then begin + glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + +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 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; + + // Draw Lyrics + ScreenSing.Lyrics.Draw(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 + + //SingBar Mod + //modded again to make it moveable: it's working, so why try harder + else if Ini.Oscilloscope = 2 then + begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + + if PlayersPlay = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); + end; + + if PlayersPlay = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + + if PlayersPlay = 3 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if Ini.LineBonus > 0 then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + if Player[E].LineBonus_Alpha <= 0 then + begin + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False + end + else + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + + end; // shift position of the pop up (if not dead) + end; // loop - for all players + end; // if - linebonus + + + if PlayersPlay = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + end + + else if PlayersPlay = 2 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end + + else if PlayersPlay = 3 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end + + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end; + if ScreenAct = 2 then begin + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); + end; + end; + end; + //PhrasenBonus - Line Bonus Mod 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(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; + + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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 + Pet: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + LyricTemp: string; + PetCz: integer; + + //SingBar Mod + A: Integer; + E: Integer; + I: Integer; + //end Singbar Mod + +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(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 + + //SingBar Mod + // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores + else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin + A := GetTickCount div 33; + if A <> Tickold then begin + Tickold := A; + for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha + I := Player[E].ScorePercentTarget - Player[E].ScorePercent; + if I > 0 then Inc(Player[E].ScorePercent) + else if I < 0 then Dec(Player[E].ScorePercent); + end; //for + end; //if + + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); + end; + + if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + + if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); + end; + end; + end; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin + A := GetTickCount div 33; + if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin + Tickold2 := A; + for E := 0 to (PlayersPlay - 1) do begin + //Change Alpha + Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; + + if Player[E].LineBonus_Alpha <= 0 then + begin + Player[E].LineBonus_Age := 0; + Player[E].LineBonus_Visible := False + end + else + begin + inc(Player[E].LineBonus_Age, 1); + //Change Position + if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out + Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); + + if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) + else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then + Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); + + end; // pop up still visible, has not reached it's position - move it + end; // loop through all players + end; // if it's time to draw them + + if PlayersPlay = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + end + + else if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end + + else if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end + + else if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + end; + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); + end; + end; + end; +//PhrasenBonus - Line Bonus Mod 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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: +// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + + // Golden Note Patch + case Wartosc of + 0: glColor4f(1, 1, 1, 0.35); + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; +begin + x := Theme.Sing.StaticTimeProgress.x; + y := Theme.Sing.StaticTimeProgress.y; + width:= Theme.Sing.StaticTimeProgress.w; + height:= Theme.Sing.StaticTimeProgress.h; + + glColor4f(Theme.Sing.StaticTimeProgress.ColR, + Theme.Sing.StaticTimeProgress.ColG, + Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + + glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(x,y); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); + glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); + glTexCoord2f(0, 1); glVertex2f(x, y+height); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1,1,1,1); +end; + +end. + diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index aaa4b3d7..09bbc1c9 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,611 +1,611 @@ -unit UGraphic; - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses - SDL, - OpenGL12, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - - //Notes - Tex_Left: array[0..6] of TTexture; //rename to tex_note_left - Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid - Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - - Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left - Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_SzczytR = 0.8; - Skin_SzczytG = 0; - Skin_SzczytB = 0; - - Skin_SzczytLimitR = 0; - Skin_SzczytLimitG = 0.8; - Skin_SzczytLimitB = 0; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_LyricsT = 494; // 500 / 510 / 400 - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses UMain, - UIni, - UDisplay, - UCommandLine, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - {$IFDEF win32} - windows, - {$ENDIF} - Classes; - -procedure LoadTextures; - - -var - P: integer; - R, G, B: real; - Col: integer; -begin - // zaladowanie tekstur - Log.LogStatus('Loading Textures', 'LoadTextures'); - Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? - - // P1-6 - for P := 1 to 6 do begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); - - Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); - Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); - Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); - end; - - Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); - Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); - Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); - //end Singbar Mod - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); - end; - {//Set Texture to Font High - Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; - Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; - Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } - //PhrasenBonus - Line Bonus Mod End - - // tworzenie czcionek - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure Initialize3D (Title: string); -var -// Icon: TIcon; - Res: TResourceStream; - ISurface: PSDL_Surface; - Pixel: PByteArray; - I: Integer; -begin - Log.LogStatus('LoadOpenGL', 'Initialize3D'); - Log.BenchmarkStart(2); - - LoadOpenGL; - - Log.LogStatus('SDL_Init', 'Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin - Log.LogError('SDL_Init Failed', 'Initialize3D'); - exit; - end; - - { //Load Icon - Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); - Icon := TIcon.Create; - Icon.LoadFromStream(Res); - Res.Free; - Icon. - //Create icon Surface - SDL_CreateRGBSurfaceFrom ( - SDL_SWSURFACE, - Icon.Width, - Icon.Height, - 32, - 128 or 64, - 32 or 16, - 8 or 4, - 2 or 1); - //SDL_BlitSurface( - - - SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} - - SDL_WM_SetCaption(PChar(Title), nil); - - InitializeScreen; - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Setting Screen', 2); - - // ladowanie tekstur - Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - Texture.Limit := 1024*1024; - - LoadTextures; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Textures', 2); - - Log.BenchmarkStart(2); - Lyric := TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); - - Log.BenchmarkStart(2); - Display := TDisplay.Create; - SDL_EnableUnicode(1); - Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - - Log.LogStatus('Loading Screens', 'Initialize3D'); - Log.BenchmarkStart(3); - - LoadLoadingScreen; - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar -// Mutex := SDL_CreateMutex; -// SDL_UnLockMutex(Mutex); - - // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will - // siehe dazu kommentar unten - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // das hier würde dann im ladethread ausgeführt - LoadScreens; - - - // TODO!!!!!!1 - // hier käme jetzt eine schleife, die - // * den ladescreen malt (ab und zu) - // * den "fortschritt" des ladescreens steuert - // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und - // * die texturen in die opengl lädt, sowie - // * dem ladethread signalisiert, dass der speicher für die textur - // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) - // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, - // dass er alles geladen hat fertig ist - // - // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche - // opengl funktionen aufzurufen, entsprechend mutexe verändert - // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, - // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... - - - //wait for loading thread to finish - // funktioniert so auch noch nicht - //SDL_WaitThread(LoadingThread, I); -// SDL_DestroyMutex(Mutex); - - Display.ActualScreen^.FadeTo(@ScreenMain); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin -// InitializeScreen; -// LoadTextures; -// LoadScreens; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - {if ParamStr(1) = '-fsblack' then begin - W := 800; - H := 600; - end; - if ParamStr(1) = '-320x240' then begin - W := 320; - H := 240; - end; } - - If (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); -// SDL_SetRefreshrate(85); -// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - if (Ini.FullScreen = 0) and (Not Params.FullScreen) then - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) - else begin - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); - end; - if (screen = nil) then begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; - end; - - // clear screen once window is being shown - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; - - // zmienne - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - swapbuffers; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - ScreenPartyNewRound := TScreenPartyNewRound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); - ScreenPartyScore := TScreenPartyScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - - end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -end. +unit UGraphic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + {$IFDEF win32} + windows, + {$ENDIF} + Classes; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + + // P1-6 + for P := 1 to 6 do begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + end; + + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); + end; + {//Set Texture to Font High + Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; + Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; + Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } + //PhrasenBonus - Line Bonus Mod End + + // tworzenie czcionek + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure Initialize3D (Title: string); +var +// Icon: TIcon; + Res: TResourceStream; + ISurface: PSDL_Surface; + Pixel: PByteArray; + I: Integer; +begin + Log.LogStatus('LoadOpenGL', 'Initialize3D'); + Log.BenchmarkStart(2); + + LoadOpenGL; + + Log.LogStatus('SDL_Init', 'Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin + Log.LogError('SDL_Init Failed', 'Initialize3D'); + exit; + end; + + { //Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + Icon. + //Create icon Surface + SDL_CreateRGBSurfaceFrom ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + //SDL_BlitSurface( + + + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} + + SDL_WM_SetCaption(PChar(Title), nil); + + InitializeScreen; + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur + Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + + LoadTextures; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Textures', 2); + +{ Log.BenchmarkStart(2); + Lyric:= TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); +} + Log.BenchmarkStart(2); + Display := TDisplay.Create; + SDL_EnableUnicode(1); + Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + + Log.LogStatus('Loading Screens', 'Initialize3D'); + Log.BenchmarkStart(3); + + LoadLoadingScreen; + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // das hier würde dann im ladethread ausgeführt + LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + + + //wait for loading thread to finish + // funktioniert so auch noch nicht + //SDL_WaitThread(LoadingThread, I); +// SDL_DestroyMutex(Mutex); + + Display.ActualScreen^.FadeTo(@ScreenMain); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + {if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) + else begin + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end; + if (screen = nil) then begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + swapbuffers; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + + end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +end. diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 64762265..5cf6114d 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -1,390 +1,537 @@ unit ULyrics; interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses SysUtils, - OpenGL12, - UMusic; +uses OpenGL12, UTexture, UThemes, UMusic; type - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - Scale: real; - Done: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; + TLyricWord = record + X: Real; //X Pos of the Word + Width: Real; //Width of the Text + TexPos: Real; //Pos of the Word (0 to 1) in the Sentence Texture + TexWidth: Real; //width of the Word in Sentence Texture (0 to 1) + Start: Cardinal; //Start of the Words in Quarters (Beats) + Length: Cardinal; //Length of the Word in Quarters + Text: String; //Text of this Word + Freestyle: Boolean; //Is this Word Freestyle + end; + ALyricWord = array of TLyricWord; + + PLyricLine = ^TLyricLine; + TLyricLine = record + Text: String; //Text of the Line + Tex: glUInt; //Texture of the Text from this Line + Width: Real; //Width of the Lyricline in Tex + Size: Byte; //Size of the Font in the Texture + Words: ALyricWord; //Words from this Line + Start: Cardinal; //Start in Quarters of teh Line + Length: Cardinal; //Length in Quarters (From Start of First Note to the End of Last Note) + Freestyle: Boolean; //Complete Line is Freestyle ? + Players: Byte; //Which Players Sing this Line (1: Player1; 2: Player2; 4: Player3; [..]) + Done: Boolean; //Is Sentence Sung end; - TLyric = class + TLyricEngine = class private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - ScaleR: real; - StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left - FontStyleI: integer; // font number - Word: array of TWord; - procedure SetX(Value: real); - procedure SetY(Value: real); - function GetClientX: real; - procedure SetAlign(Value: integer); - function GetSize: real; - procedure SetSize(Value: real); - procedure SetSelected(Value: integer); - procedure SetDone(Value: real); - procedure SetScale(Value: real); - procedure SetStyle(Value: integer); - procedure SetFStyle(Value: integer); - procedure Refresh; - procedure DrawNormal(W: integer); - procedure DrawPlain(W: integer); - procedure DrawScaled(W: integer); - procedure DrawSlide(W: integer); + EoLastSentence: Real; //When did the Last Sentence End (in Beats) + UpperLine: TLyricLine; //Line in the Upper Part of the Lyric Display + LowerLine: TLyricLine; //Line in the Lower Part of teh Lyric Display + QueueLine: TLyricLine; //Line that is in Queue and will be added when next Line is Finished + PUpperLine, PLowerLine, PQueueLine: PLyricLine; + + IndicatorTex: TTexture; //Texture for Lyric Indikator(Bar that indicates when the Line start) + BallTex: TTexture; //Texture of the Ball for cur. Word hover in Ballmode + PlayerIconTex: array[0..5] of //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + array [0..1] of + TTexture; + + inQueue: Boolean; + LCounter: Word; + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); + procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); public - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - Text: string; // LCD - - procedure AddWord(Text: string); // Moved from published, lazarus didnt like it - procedure AddCzesc(NrCzesci: integer); - - function SelectedLetter: integer; // LCD - function SelectedLength: integer; // LCD - - procedure Clear; - procedure Draw; - - published - property X: real write SetX; - property Y: real write SetY; - property ClientX: real read GetClientX; - property Align: integer write SetAlign; - property Size: real read GetSize write SetSize; - property Selected: integer read SelectedI write SetSelected; - property Done: real write SetDone; - property Scale: real write SetScale; - property Style: integer write SetStyle; - property FontStyle: integer write SetFStyle; + //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_akt: TRGBA; //Color of teh active Word + FontStyle: Byte; //Font for the Lyric Text + FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen + + HoverEffekt: Byte; //Effekt of Hovering active Word: 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FadeInEffekt: Byte; //Effekt for Line Fading in: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards from Bottom to Pos + FadeOutEffekt: Byte; //Effekt for Line Fading out: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards + + UseLinearFilter:Boolean; //Should Linear Tex Filter be used + + //Song specific Settings + BPM: Real; + Resolution: Integer; + + + //properties to easily update this Class within other Parts of Code + property LineinQueue: Boolean read inQueue; //True when there is a Line in Queue + property LineCounter: Word read LCounter; //Lines that was Progressed so far (after last Clear) + + Constructor Create; overload; //Constructor, just get Memory + Constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); overload; + Procedure LoadTextures; //Load Player Textures and Create + + Procedure AddLine(Line: PLine); //Adds a Line to the Queue if there is Space + Procedure Draw (Beat: Real); //Procedure Draws Lyrics; Beat is curent Beat in Quarters + Procedure Clear (const cBPM: Real = 0; const cResolution: Integer = 0); //Clears all cached Song specific Information + + Destructor Free; //Frees Memory end; -var - Lyric: TLyric; +const LyricTexStart = 2/512; implementation -uses TextGL, UGraphic, UDrawTexture; +uses SysUtils, USkins, TextGL, UGraphic, UDisplay, dialogs; -procedure TLyric.SetX(Value: real); +//----------- +//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else +//----------- +procedure glColorRGB(Color: TRGB); overload; begin - XR := Value; + glColor3f(Color.R, Color.G, Color.B); end; -procedure TLyric.SetY(Value: real); +procedure glColorRGB(Color: TRGBA); overload; begin - YR := Value; + glColor4f(Color.R, Color.G, Color.B, Color.A); end; -function TLyric.GetClientX: real; + + +//--------------- +// Create - Constructor, just get Memory +//--------------- +Constructor TLyricEngine.Create; begin - Result := Word[0].X; + 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; end; -procedure TLyric.SetAlign(Value: integer); +Constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); begin - AlignI := Value; -// if AlignInt = 0 then beep; + Create; + UpperLineX := ULX; + UpperLineW := ULW; + UpperLineY := ULY; + UpperLineSize := Trunc(ULS); + + LowerLineX := LLX; + LowerLineW := LLW; + LowerLineY := LLY; + LowerLineSize := Trunc(LLS); + LoadTextures; end; -function TLyric.GetSize: real; + +//--------------- +// Free - Frees Memory +//--------------- +Destructor TLyricEngine.Free; begin - Result := SizeR; + end; -procedure TLyric.SetSize(Value: real); +//--------------- +// Clear - Clears all cached Song specific Information +//--------------- +Procedure TLyricEngine.Clear (const cBPM: Real; const cResolution: Integer); begin - SizeR := Value; + BPM := cBPM; + Resolution := cResolution; + LCounter := 0; + inQueue := False; + + UpperLine.Done := True; + LowerLine.Done := True; + QueueLine.Done := True; + + PUpperline:=@UpperLine; + PLowerLine:=@LowerLine; + PQueueLine:=@QueueLine; end; -procedure TLyric.SetSelected(Value: integer); + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +Procedure TLyricEngine.LoadTextures; var - W: integer; -begin - if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - Word[SelectedI].Selected := false; - Word[SelectedI].ColR := ColR; - Word[SelectedI].ColG := ColG; - Word[SelectedI].ColB := ColB; - Word[SelectedI].Done := 0; - end; + I: Integer; + PTexData: Pointer; - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - Word[Value].Selected := true; - Word[Value].ColR := ColSR; - Word[Value].ColG := ColSG; - Word[Value].ColB := ColSB; - Word[Value].Scale := ScaleR; - end; - end; + function CreateLineTex: glUint; + begin + GetMem(pTexData, 1024*128*4); //get Memory to save Tex in - if (StyleI = 1) or (StyleI = 3) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - for W := SelectedI to High(Word) do begin - Word[W].Selected := false; - Word[W].ColR := ColR; - Word[W].ColG := ColG; - Word[W].ColB := ColB; - Word[W].Done := 0; - end; - end; + //generate and bind Texture + glGenTextures(1, Result); + glBindTexture(GL_TEXTURE_2D, Result); - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - for W := 0 to Value do begin - Word[W].Selected := true; - Word[W].ColR := ColSR; - Word[W].ColG := ColSG; - Word[W].ColB := ColSB; - Word[W].Scale := ScaleR; - Word[W].Done := 1; - end; + //Get Memory + glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); + + 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; + + //Free now unused Memory + FreeMem(pTexData); end; +begin + //Load Texture for Lyric Indikator(Bar that indicates when the Line start) + IndicatorTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - Refresh; -end; + //Load Texture of the Ball for cur. Word hover in Ballmode + BallTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); -procedure TLyric.SetDone(Value: real); -var - W: integer; -begin - W := SelectedI; - if W > -1 then - Word[W].Done := Value; -end; + //Load PlayerTexs + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; -procedure TLyric.SetScale(Value: real); -begin - ScaleR := Value; -end; + //atm just unset other texs + For I := 2 to 5 do + begin + PlayerIconTex[I][0].TexNum := high(Cardinal); //Set to C's -1 + PlayerIconTex[I][1].TexNum := high(Cardinal); + end; -procedure TLyric.SetStyle(Value: integer); -begin - StyleI := Value; + //Create LineTexs + UpperLine.Tex := CreateLineTex; + LowerLine.Tex := CreateLineTex; + QueueLine.Tex := CreateLineTex; end; -procedure TLyric.SetFStyle(Value: integer); -begin - FontStyleI := Value; -end; -procedure TLyric.AddWord(Text: string); +//--------------- +// AddLine - Adds LyricLine to queue +//--------------- +Procedure TLyricEngine.AddLine(Line: PLine); var - WordNum: integer; + LyricLine: PLyricLine; + I: Integer; + countNotes: Cardinal; + PosX: Real; + Viewport: Array[0..3] of Integer; begin - WordNum := Length(Word); - SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin - Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + //Only Add Lines if there is enough space + If not LineinQueue then + begin + //Set Pointer to Line to Write + If (LineCounter = 0) then + LyricLine := PUpperLine //Set Upper Line + else if (LineCounter = 1) then + LyricLine := PLowerLine //Set Lower Line + else + begin + LyricLine := PQueueLine; //Set Queue Line + inQueue := True; //now there is a Queued Line + end; + end + else + begin + LyricLine:=PUpperLine; + PUpperLine:=PLowerLine; + PLowerLine:=PQueueLine; + PQueueLine:=LyricLine; end; - Word[WordNum].Y := YR; - Word[WordNum].Size := SizeR; - Word[WordNum].FontStyle := FontStyleI; // new - SetFontStyle(FontStyleI); - SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(pchar(Text)); - Word[WordNum].Text := Text; - Word[WordNum].ColR := ColR; - Word[WordNum].ColG := ColG; - Word[WordNum].ColB := ColB; - Word[WordNum].Scale := 1; - Word[WordNum].Done := 0; - Word[WordNum].Italic := Italic; - - Refresh; -end; + //Check if Sentence has Notes + If (Length(Line.Nuta) > 0) then + begin + //Copy Values from SongLine to LyricLine + CountNotes := high(Line.Nuta); + LyricLine.Start := Line.Nuta[0].Start; + LyricLine.Length := Line.Nuta[CountNotes].Start + Line.Nuta[CountNotes].Dlugosc - LyricLine.Start; + LyricLine.Freestyle := True; //is set by And Notes Freestyle while copying Notes + LyricLine.Text := ''; //Also Set while copying Notes + LyricLine.Players := 127; //All Players for now, no Duett Mode available + //Copy Words + SetLength(LyricLine.Words, CountNotes + 1); + For I := 0 to CountNotes do + begin + LyricLine.Freestyle := LyricLine.Freestyle AND Line.Nuta[I].FreeStyle; + LyricLine.Words[I].Start := Line.Nuta[I].Start; + LyricLine.Words[I].Length := Line.Nuta[I].Dlugosc; + LyricLine.Words[I].Text := Line.Nuta[I].Tekst; + LyricLine.Words[I].Freestyle := Line.Nuta[I].FreeStyle; + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text + end; -procedure TLyric.AddCzesc(NrCzesci: integer); -var - N: integer; -begin - Clear; - for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin - Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; - AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); - Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; - end; - Selected := -1; -end; + //Set Font Params + SetFontStyle(FontStyle); + SetFontPos(0, 0); + LyricLine.Size := UpperLineSize; + SetFontSize(LyricLine.Size); + SetFontItalic(False); + glColor4f(1, 1, 1, 1); -procedure TLyric.Clear; -begin -{ ColR := Skin_FontR; - ColG := Skin_FontG; - ColB := Skin_FontB;} - SetLength(Word, 0); - Text := ''; - SelectedI := -1; -end; + //Change Fontsize to Fit the Screen + While (LyricLine.Width > 508) do + begin + Dec(LyricLine.Size); -procedure TLyric.Refresh; -var - W: integer; - TotWidth: real; -begin - if AlignI = 1 then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; - - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; + if (LyricLine.Size <=1) then + Break; + + SetFontSize(LyricLine.Size); + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + end; + + //Set Word Positions and Line Size + PosX := 2 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; + For I := 0 to High(LyricLine.Words) do + begin + LyricLine.Words[I].X := PosX; + LyricLine.Words[I].Width := glTextWidth(PChar(LyricLine.Words[I].Text)); + LyricLine.Words[I].TexPos := PosX / 512; + LyricLine.Words[I].TexWidth := LyricLine.Words[I].TexWidth / 512; + + PosX := PosX + LyricLine.Words[I].Width; + end; + + //Create LyricTexture + //Prepare Ogl + glGetIntegerv(GL_VIEWPORT, @ViewPort); + glClearColor(0.0,0.0,0.0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + {glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, 1024, 64, 0, -1, 100); + glMatrixMode(GL_MODELVIEW);} + glViewport(0, 0, 512, 512); + + //Draw Lyrics + SetFontPos(0, 0); + glPrint(PChar(LyricLine.Text)); + + Display.ScreenShot; + //Copy to Texture + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 448, 512, 64, 0); + + //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]); + {glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); } end; -end; -procedure TLyric.Draw; -var - W: integer; -begin - case StyleI of - 0: - begin - for W := 0 to High(Word) do - DrawNormal(W); - end; - 1: - begin - for W := 0 to High(Word) do - DrawPlain(W); - end; - 2: // zoom - begin - for W := 0 to High(Word) do - if not Word[W].Selected then - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then - DrawScaled(W); - end; - 3: // slide - begin - for W := 0 to High(Word) do begin - if not Word[W].Selected then - DrawNormal(W) - else - DrawSlide(W); - end; - end; - 4: // ball - begin - for W := 0 to High(Word) do - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then begin - Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; - Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); - Tex_Ball.W := 20; - Tex_Ball.H := 20; - DrawTexture(Tex_Ball); - end; - end; - end; // case + //Increase the Counter + Inc(LCounter); end; -procedure TLyric.DrawNormal(W: integer); -begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)); -end; -procedure TLyric.DrawPlain(W: integer); -var - D: real; +//--------------- +// 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 - D := Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); + DrawLyrics(Beat); - if D = 0 then - glColor3f(ColR, ColG, ColB) - else - glColor3f(ColSR, ColSG, ColSB); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_Alpha {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_Alpha); + glBindTexture(GL_TEXTURE_2D, PUpperLine^.Tex); + + glColor4f(1,1,0,1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(100, 100); + glTexCoord2f(0, 0); glVertex2f(100, 200); + glTexCoord2f(1, 0); glVertex2f(612, 200); + glTexCoord2f(1, 1); glVertex2f(612, 100); + glEnd; + + glBindTexture(GL_TEXTURE_2D, PLowerLine^.Tex); + + glColor4f(1,0,1,1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(100, 200); + glTexCoord2f(0, 0); glVertex2f(100, 300); + glTexCoord2f(1, 0); glVertex2f(612, 300); + glTexCoord2f(1, 1); glVertex2f(612, 200); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); - glPrint(pchar(Word[W].Text)); end; -procedure TLyric.DrawScaled(W: integer); -var - D: real; +//--------------- +// DrawLyrics(private) - Helper for Draw; main Drawing procedure +//--------------- +procedure TLyricEngine.DrawLyrics (Beat: Real); begin - // previous plus dynamic scaling effect - D := 1-Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); - SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)) + DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); end; -procedure TLyric.DrawSlide(W: integer); -var - D: real; +//--------------- +// 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 - D := Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); + Case Enabled of + True: IEnabled := 0; + False: IEnabled:= 1; + end; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); + + glColor4f(1,1,1,Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y + Size); + glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); + glTexCoord2f(1, 0); glVertex2f(X + Size, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); end; - -function TLyric.SelectedLetter; // LCD +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); var - W: integer; + I: Integer; + CurWord: Integer; + Progress: Real; + LyricX: Real; //Left Corner on X Axis + LyricX2: Real;//Right Corner " " + LyricScale: Real; //Up or Downscale the Lyrics need + IconSize: Real; + IconAlpha: Real; begin - Result := 1; - for W := 0 to SelectedI-1 do - Result := Result + Length(Word[W].Text); -end; +{ For I := 0 to High(Line.Words) do + begin + //Set Font Params + SetFontStyle(FontStyle); + SetFontSize(Size); + SetFontItalic(Line.Words[I].Freestyle); + glColor4f(1, 1, 1, 1); + + SetFontPos(Line.Words[I].X, Y); + + glPrint(PChar(Line.Words[I].Text)); + end; } + + LyricScale := Size / Line.Size; + + //Draw Icons + IconSize := (2 * Size); + //IconAlpha := 1; + IconAlpha := Frac(Beat/(Resolution*4)); + + {DrawPlayerIcon (0, True, X, Y, IconSize, IconAlpha); + DrawPlayerIcon (1, True, X + IconSize + 1, Y, IconSize, IconAlpha); + DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} + + //Check if a Word in the Sentence is active + if ((Line.Start > Beat) AND (Line.Start + Line.Length < Beat)) then + begin + //Get Start Position: + { Start of Line - Width of all Icons + LineWidth/2 (Center} + LyricX := X + (W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3); + + LyricX2 := LyricX + Line.Width; + + //Draw complete Sentence + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_COLOR); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); + glTexCoord2f(1, 0); glVertex2f(LyricX + LyricX2, Y + 64 * W / 512); + glTexCoord2f(1, 1); glVertex2f(LyricX + LyricX2, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end + else + begin -function TLyric.SelectedLength: integer; // LCD -begin - Result := Length(Word[SelectedI].Text); + end; + + {//Search for active Word + For I := 0 to High(Line.Words) do + if (Line.Words[I].Start < Beat) then + begin + CurWord := I - 1; + end; + + if (CurWord < 0) then Exit; + + //Draw Part until cur Word + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}{, GL_ONE_MINUS_SRC_COLOR); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(X, Y); + glTexCoord2f(0, 0); glVertex2f(X, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 0); glVertex2f(X + W, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 1); glVertex2f(X + W, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D);} end; + end. + diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index f06345ec..1970730a 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,792 +1,796 @@ -unit UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - UGraphic, - UMusic, - URecord, - UTime, - SysUtils, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - OpenGL12, - {$IFDEF UseSerialPort} - zlportio {you can disable it and all PortWriteB calls}, - {$ENDIF} - ULCD, - ULight, - UThemes; - -type - TPlayer = record - Name: string; - - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreI: integer; - ScoreLineI: integer; - ScoreGoldenI: integer; - ScoreTotalI: integer; - - - - //SingBar Mod - ScoreLast: Real;//Last Line Score - ScorePercent: integer;//Aktual Fillstate of the SingBar - ScorePercentTarget: integer;//Target Fillstate of the SingBar - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: Single; - LineBonus_PosY: Single; - LineBonus_Alpha: Single; - LineBonus_Visible: boolean; - LineBonus_Text: string; - LineBonus_Color: TRGB; - LineBonus_Age: Integer; - LineBonus_Rating: Integer; - //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes - LineBonus_TargetX: integer; - LineBonus_TargetY: integer; - LineBonus_StartX: integer; - LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End - - //PerfectLineTwinkle Mod (effect) - LastSentencePerfect: Boolean; - //PerfectLineTwinkle Mod end - - -// Meter: real; - - HighNut: integer; - IlNut: integer; - Nuta: array of record - Start: integer; - Dlugosc: integer; - Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute - Ton: real; - Perfect: boolean; // true if the note matches the original one, lit the star - - - - // Half size Notes Patch - Hit: boolean; // true if the note Hits the Line - //end Half size Notes Patch - - - - end; - end; - - -var - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; - - OGL: Boolean; - Done: Boolean; - Event: TSDL_event; - FileName: string; - Restart: boolean; - - // gracz i jego nuty - Player: array of TPlayer; - PlayersPlay: integer; - -procedure InitializePaths; - -procedure MainLoop; -procedure CheckEvents; -procedure Sing(Sender: TScreenSing); -procedure NewSentence(Sender: TScreenSing); -procedure NewBeat(Sender: TScreenSing); // executed when on then new beat -procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click -procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection -//procedure NewHalf; // executed when in the half between beats -procedure NewNote(Sender: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - -implementation -uses USongs, UJoystick, math, UCommandLine; - -procedure MainLoop; -var - Delay: integer; -begin - SDL_EnableKeyRepeat(125, 125); - While not Done do - Begin - // joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - done := not Display.Draw; - SwapBuffers; - - // light - Light.Refresh; - - // delay - CountMidTime; -// if 1000*TimeMid > 100 then beep; - Delay := Floor(1000 / 100 - 1000 * TimeMid); - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - CountSkipTime; - - // reinitialization of graphics - if Restart then begin - Reinitialize3D; - Restart := false; - end; - - End; - UnloadOpenGL; -End; - -Procedure CheckEvents; -//var -// p: pointer; -Begin - if not Assigned(Display.NextScreen) then - While SDL_PollEvent( @event ) = 1 Do - Begin -// beep; - Case Event.type_ Of - SDL_QUITEV: begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; -{ SDL_MOUSEBUTTONDOWN: - With Event.button Do - Begin - If State = SDL_BUTTON_LEFT Then - Begin - // - End; - End; // With} - SDL_KEYDOWN: - begin - //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path - if (Event.key.keysym.sym = SDLK_SYSREQ) then - Display.ScreenShot - - // popup hack... if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - // end of popup hack - - else - begin - // check for Screen want to Exit - done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); - - //If Screen wants to Exit - if done then - begin - //If Question Option is enabled then Show Exit Popup - if (Ini.AskbeforeDel = 1) then - begin - Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); - end - else //When asking for exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - end; - - end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then - end; -// SDL_JOYAXISMOTION: -// begin -// beep -// end; - SDL_JOYBUTTONDOWN: - begin - beep - end; - End; // Case Event.type_ - End; // While -End; // CheckEvents - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(AktSong.BPM) = BPMNum then begin - // last BPM - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end else begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then begin - // there is still remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end else begin - // there is no remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -// TopBeat: real; -// TempBeat: real; -// TempTime: real; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; - - (* 2 BPMs *) -{ if Length(AktSong.BPM) > 1 then begin - (* new system *) - CurBeat := 0; - TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); - if TopBeat > AktSong.BPM[1].StartBeat then begin - // analyze second BPM - Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); - CurBeat := AktSong.BPM[1].StartBeat; - TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); - Result := CurBeat + TopBeat; - - end else begin - (* pierwszy przedzial *) - Result := TopBeat; - end; - end; // if} - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end; // if -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - Result := AktSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin - if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin - // full range - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin - // in the middle - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - -{ while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end;} - end; // if} -end; - -procedure Sing(Sender: TScreenSing); -var - Pet: integer; - PetGr: integer; - CP: integer; - Done: real; - N: integer; -begin - Czas.Teraz := Czas.Teraz + TimeSkip; - - Czas.OldBeat := Czas.AktBeat; - Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function - Czas.AktBeat := Floor(Czas.MidBeat); - -// Czas.OldHalf := Czas.AktHalf; -// Czas.MidHalf := Czas.MidBeat + 0.5; -// Czas.AktHalf := Floor(Czas.MidHalf); - - Czas.OldBeatC := Czas.AktBeatC; - Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); - Czas.AktBeatC := Floor(Czas.MidBeatC); - - Czas.OldBeatD := Czas.AktBeatD; - Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP - Czas.AktBeatD := Floor(Czas.MidBeatD); - Czas.FracBeatD := Frac(Czas.MidBeatD); - - // sentences routines - for PetGr := 0 to 0 do begin;//High(Gracz) do begin - CP := PetGr; - // ustawianie starej czesci - Czas.OldCzesc := Czesci[CP].Akt; - - // wybieranie aktualnej czesci - for Pet := 0 to Czesci[CP].High do - if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; - - // czysczenie nut gracza, gdy to jest nowa plansza - // (optymizacja raz na halfbeat jest zla) - if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); - - end; // for PetGr - - // wykonuje operacje raz na beat - if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then - NewBeat(Sender); - - // make some operations on clicks - if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then - NewBeatC(Sender); - - // make some operations when detecting new voice pitch - if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then - NewBeatD(Sender); - - // wykonuje operacje w polowie beatu -// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then -// NewHalf; - - // plynnie przesuwa text - Done := 1; - for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) - and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then - Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); - - N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; - - // wylacza ostatnia nute po przejsciu - if (Ini.LyricsEffect = 1) and (Done = 1) and - (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) - then Sender.LyricMain.Selected := -1; - - if Done > 1 then Done := 1; - Sender.LyricMain.Done := Done; - - // use Done with LCD -{ with ScreenSing do begin - if LyricMain.Selected >= 0 then begin - LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); - LCD.ShowCursor; - end; - end;} - - -end; - -procedure NewSentence(Sender: TScreenSing); -var -G: Integer; -begin - // czyszczenie nut graczy - for G := 0 to High(Player) do begin - Player[G].IlNut := 0; - Player[G].HighNut := -1; - SetLength(Player[G].Nuta, 0); - end; - - // wstawianie tekstow - with Sender do begin - LyricMain.AddCzesc(Czesci[0].Akt); - if Czesci[0].Akt < Czesci[0].High then - LyricSub.AddCzesc(Czesci[0].Akt+1) - else - LyricSub.Clear; - end; - - Sender.UpdateLCD; - - //On Sentence Change... - Sender.onSentenceChange(Czesci[0].Akt); -end; - -procedure NewBeat(Sender: TScreenSing); -var - Pet: integer; -// TempBeat: integer; -begin - // ustawia zaznaczenie tekstu -// SingScreen.LyricMain.Selected := -1; - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin - // operates on currently beated note - Sender.LyricMain.Selected := Pet; - -// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); -// LCD.ShowCursor; - - LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); - LCD.ShowCursor; - - end; -end; - -procedure NewBeatC; -var - Pet: integer; -// LPT_1: integer; -// LPT_2: integer; -begin -// LPT_1 := 1; -// LPT_2 := 1; - - // beat click - if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - Music.PlayClick; - - // debug system on LPT - if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin - //LPT_1 := 0; -// Light.LightOne(0, 150); - - Light.LightOne(1, 200); // beat light - if ParamStr(1) = '-doublelights' then - Light.LightOne(0, 200); // beat light - - -{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then - Light.LightOne(0, 150) - else - Light.LightOne(1, 150)} - end; - - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin - // click assist - if Ini.ClickAssist = 1 then - Music.PlayClick; - - //LPT_2 := 0; - if ParamStr(1) <> '-doublelights' then - Light.LightOne(0, 150); //125 - - - // drum machine -(* TempBeat := Czas.AktBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; -// if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) - end; - - {$IFDEF UseSerialPort} - // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala - {$ENDIF} -end; - -procedure NewBeatD(Sender: TScreenSing); -begin - NewNote(Sender); -end; - -//procedure NewHalf; -//begin -// NewNote; -//end; - -procedure NewNote(Sender: TScreenSing); -var - CP: integer; // current player - S: integer; // sentence - SMin: integer; - SMax: integer; - SDet: integer; // temporary: sentence of detected note - Pet: integer; - Mozna: boolean; - Nowa: boolean; - Range: integer; - NoteHit:boolean; -begin -// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); -// beep; - - // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) - // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do begin - - // analyze buffer - Sound[CP].AnalizujBufor; - - // adds some noise -// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; - - // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SMin := Czesci[0].Akt-1; - if SMin < 0 then SMin := 0; - SMax := Czesci[0].Akt; - - // check if we can add new note - Mozna := false; - SDet:=SMin; - for S := SMin to SMax do - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) - and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 - then begin - SDet := S; - Mozna := true; - Break; - end; - - S := SDet; - - - - - -// Czas.SzczytJest := true; -// Czas.Ton := 27; - - // gdy moze, to dodaje nute - if (Sound[CP].SzczytJest) and (Mozna) then begin - // operowanie na ostatniej nucie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + - Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin - // to robi, tylko dla pary nut (oryginalnej i gracza) - - // przesuwanie tonu w odpowiednia game - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - Sound[CP].Ton := Sound[CP].Ton - 12; - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - Sound[CP].Ton := Sound[CP].Ton + 12; - - // Half size Notes Patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin - Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; - - - // Half size Notes Patch - NoteHit := true; - - - if (Ini.LineBonus = 0) then - begin - // add points without LineBonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end - else - begin - // add points with Line Bonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end; - - Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; - Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; - - Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; - end; - - end; // operowanie - - // sprawdzanie czy to nowa nuta, czy przedluzenie - if S = SMax then begin - Nowa := true; - // jezeli ostatnia ma ten sam ton - if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) - and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) - then Nowa := false; - // jezeli jest jakas nowa nuta na sprawdzanym beacie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then - Nowa := true; - - // dodawanie nowej nuty - if Nowa then begin - // nowa nuta - Player[CP].IlNut := Player[CP].IlNut + 1; - Player[CP].HighNut := Player[CP].HighNut + 1; - SetLength(Player[CP].Nuta, Player[CP].IlNut); - Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl - Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; - - - // Half Note Patch - Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; - - - // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); - - end else begin - // przedluzenie nuty - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; - end; - - - // check for perfect note and then lit the star (on Draw) - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) - and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin - Player[CP].Nuta[Player[CP].HighNut].Perfect := true; - end; - - end;// else beep; // if S = SMax - - end; // if moze - end; // for CP -// Log.LogStatus('EndBeat', 'NewBeat'); - -//On Sentence End -> For LineBonus + SingBar -if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then -if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then - Sender.onSentenceEnd(sDet); - -end; - -procedure ClearScores(PlayerNum: integer); -begin - Player[PlayerNum].Score := 0; - Player[PlayerNum].ScoreI := 0; - Player[PlayerNum].ScoreLine := 0; - Player[PlayerNum].ScoreLineI := 0; - Player[PlayerNum].ScoreGolden := 0; - Player[PlayerNum].ScoreGoldenI := 0; - Player[PlayerNum].ScoreTotalI := 0; - - - //SingBar Mod - Player[PlayerNum].ScoreLast := 0; - Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts - Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts - //end SingBar Mod - - //PhrasenBonus - Line Bonus Mod - Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus - Player[PlayerNum].LineBonus_Alpha := 0; - Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; - Player[PlayerNum].LineBonus_TargetY := 30; - //PhrasenBonus - Line Bonus Mod End -end; - -//-------------------- -// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist -//-------------------- -procedure InitializePaths; - - // Initialize a Path Variable - // After Setting Paths, make sure that Paths exist - function initialize_path( out aPathVar : String; const aLocation : String ): boolean; - var - lWriteable: Boolean; - begin - aPathVar := aLocation; - - If DirectoryExists(aPathVar) then - lWriteable := ForceDirectories(aPathVar) - else - lWriteable := false; - - if not lWriteable then - Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); - - result := lWriteable; - end; - -begin - - GamePath := ExtractFilePath(ParamStr(0)); - - initialize_path( LogPath , GamePath ); - initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); - initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); - initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); - initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); - initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); - initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); - initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); - initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); - - DecimalSeparator := ','; -end; - -end. - +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphic, + UMusic, + URecord, + UTime, + SysUtils, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + OpenGL12, + {$IFDEF UseSerialPort} + zlportio {you can disable it and all PortWriteB calls}, + {$ENDIF} + ULCD, + ULight, + UThemes; + +type + TPlayer = record + Name: string; + + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreI: integer; + ScoreLineI: integer; + ScoreGoldenI: integer; + ScoreTotalI: integer; + + + + //SingBar Mod + ScoreLast: Real;//Last Line Score + ScorePercent: integer;//Aktual Fillstate of the SingBar + ScorePercentTarget: integer;//Target Fillstate of the SingBar + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + LineBonus_PosX: Single; + LineBonus_PosY: Single; + LineBonus_Alpha: Single; + LineBonus_Visible: boolean; + LineBonus_Text: string; + LineBonus_Color: TRGB; + LineBonus_Age: Integer; + LineBonus_Rating: Integer; + //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes + LineBonus_TargetX: integer; + LineBonus_TargetY: integer; + LineBonus_StartX: integer; + LineBonus_StartY: integer; + //PhrasenBonus - Line Bonus Mod End + + //PerfectLineTwinkle Mod (effect) + LastSentencePerfect: Boolean; + //PerfectLineTwinkle Mod end + + +// Meter: real; + + HighNut: integer; + IlNut: integer; + Nuta: array of record + Start: integer; + Dlugosc: integer; + Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute + Ton: real; + Perfect: boolean; // true if the note matches the original one, lit the star + + + + // Half size Notes Patch + Hit: boolean; // true if the note Hits the Line + //end Half size Notes Patch + + + + end; + end; + + +var + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; + + OGL: Boolean; + Done: Boolean; + Event: TSDL_event; + FileName: string; + Restart: boolean; + + // gracz i jego nuty + Player: array of TPlayer; + PlayersPlay: integer; + +procedure InitializePaths; + +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Sender: TScreenSing); +procedure NewSentence(Sender: TScreenSing); +procedure NewBeat(Sender: TScreenSing); // executed when on then new beat +procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click +procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection +//procedure NewHalf; // executed when in the half between beats +procedure NewNote(Sender: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation +uses USongs, UJoystick, math, UCommandLine; + +procedure MainLoop; +var + Delay: integer; +begin + SDL_EnableKeyRepeat(125, 125); + While not Done do + Begin + // joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // light + Light.Refresh; + + // delay + CountMidTime; +// if 1000*TimeMid > 100 then beep; + Delay := Floor(1000 / 100 - 1000 * TimeMid); + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + CountSkipTime; + + // reinitialization of graphics + if Restart then begin + Reinitialize3D; + Restart := false; + end; + + End; + UnloadOpenGL; +End; + +Procedure CheckEvents; +//var +// p: pointer; +Begin + if not Assigned(Display.NextScreen) then + While SDL_PollEvent( @event ) = 1 Do + Begin +// beep; + Case Event.type_ Of + SDL_QUITEV: begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; +{ SDL_MOUSEBUTTONDOWN: + With Event.button Do + Begin + If State = SDL_BUTTON_LEFT Then + Begin + // + End; + End; // With} + SDL_KEYDOWN: + begin + //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path + if (Event.key.keysym.sym = SDLK_SYSREQ) then + Display.ScreenShot + + // popup hack... if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + // end of popup hack + + else + begin + // check for Screen want to Exit + done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + + //If Screen wants to Exit + if done then + begin + //If Question Option is enabled then Show Exit Popup + if (Ini.AskbeforeDel = 1) then + begin + Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); + end + else //When asking for exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then + end; +// SDL_JOYAXISMOTION: +// begin +// beep +// end; + SDL_JOYBUTTONDOWN: + begin + beep + end; + End; // Case Event.type_ + End; // While +End; // CheckEvents + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(AktSong.BPM) = BPMNum then begin + // last BPM + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end else begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then begin + // there is still remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end else begin + // there is no remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +// TopBeat: real; +// TempBeat: real; +// TempTime: real; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; + + (* 2 BPMs *) +{ if Length(AktSong.BPM) > 1 then begin + (* new system *) + CurBeat := 0; + TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); + if TopBeat > AktSong.BPM[1].StartBeat then begin + // analyze second BPM + Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); + CurBeat := AktSong.BPM[1].StartBeat; + TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); + Result := CurBeat + TopBeat; + + end else begin + (* pierwszy przedzial *) + Result := TopBeat; + end; + end; // if} + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end; // if +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + Result := AktSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin + // full range + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin + // in the middle + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + +{ while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end;} + end; // if} +end; + +procedure Sing(Sender: TScreenSing); +var + Pet: integer; + PetGr: integer; + CP: integer; + Done: real; + N: integer; +begin + Czas.Teraz := Czas.Teraz + TimeSkip; + + Czas.OldBeat := Czas.AktBeat; + Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.AktBeat := Floor(Czas.MidBeat); + +// Czas.OldHalf := Czas.AktHalf; +// Czas.MidHalf := Czas.MidBeat + 0.5; +// Czas.AktHalf := Floor(Czas.MidHalf); + + Czas.OldBeatC := Czas.AktBeatC; + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); + Czas.AktBeatC := Floor(Czas.MidBeatC); + + Czas.OldBeatD := Czas.AktBeatD; + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.AktBeatD := Floor(Czas.MidBeatD); + Czas.FracBeatD := Frac(Czas.MidBeatD); + + // sentences routines + for PetGr := 0 to 0 do begin;//High(Gracz) do begin + CP := PetGr; + // ustawianie starej czesci + Czas.OldCzesc := Czesci[CP].Akt; + + // wybieranie aktualnej czesci + for Pet := 0 to Czesci[CP].High do + if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; + + // czysczenie nut gracza, gdy to jest nowa plansza + // (optymizacja raz na halfbeat jest zla) + if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); + + end; // for PetGr + + // wykonuje operacje raz na beat + if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then + NewBeat(Sender); + + // make some operations on clicks + if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then + NewBeatC(Sender); + + // make some operations when detecting new voice pitch + if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then + NewBeatD(Sender); + + // wykonuje operacje w polowie beatu +// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then +// NewHalf; + + // plynnie przesuwa text + Done := 1; + for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) + and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then + Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); + + N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; + + // wylacza ostatnia nute po przejsciu + {// todo: Lyrics + if (Ini.LyricsEffect = 1) and (Done = 1) and + (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) + then Sender.LyricMain.Selected := -1; + + if Done > 1 then Done := 1; + Sender.LyricMain.Done := Done; } + + // use Done with LCD +{ with ScreenSing do begin + if LyricMain.Selected >= 0 then begin + LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); + LCD.ShowCursor; + end; + end;} + + +end; + +procedure NewSentence(Sender: TScreenSing); +var +G: Integer; +begin + // czyszczenie nut graczy + for G := 0 to High(Player) do begin + Player[G].IlNut := 0; + Player[G].HighNut := -1; + SetLength(Player[G].Nuta, 0); + end; + + // Add Words to Lyrics + with Sender do begin + {LyricMain.AddCzesc(Czesci[0].Akt); + if Czesci[0].Akt < Czesci[0].High then + LyricSub.AddCzesc(Czesci[0].Akt+1) + else + LyricSub.Clear;} + while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do + Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]); + end; + + Sender.UpdateLCD; + + //On Sentence Change... + Sender.onSentenceChange(Czesci[0].Akt); +end; + +procedure NewBeat(Sender: TScreenSing); +var + Pet: integer; +// TempBeat: integer; +begin + // ustawia zaznaczenie tekstu +// SingScreen.LyricMain.Selected := -1; + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin + // operates on currently beated note + //Todo: Lyrics + //Sender.LyricMain.Selected := Pet; + +// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); +// LCD.ShowCursor; + + //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); + LCD.ShowCursor; + + end; +end; + +procedure NewBeatC; +var + Pet: integer; +// LPT_1: integer; +// LPT_2: integer; +begin +// LPT_1 := 1; +// LPT_2 := 1; + + // beat click + if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then + Music.PlayClick; + + // debug system on LPT + if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin + //LPT_1 := 0; +// Light.LightOne(0, 150); + + Light.LightOne(1, 200); // beat light + if ParamStr(1) = '-doublelights' then + Light.LightOne(0, 200); // beat light + + +{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then + Light.LightOne(0, 150) + else + Light.LightOne(1, 150)} + end; + + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin + // click assist + if Ini.ClickAssist = 1 then + Music.PlayClick; + + //LPT_2 := 0; + if ParamStr(1) <> '-doublelights' then + Light.LightOne(0, 150); //125 + + + // drum machine +(* TempBeat := Czas.AktBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; +// if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) + end; + + {$IFDEF UseSerialPort} + // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$ENDIF} +end; + +procedure NewBeatD(Sender: TScreenSing); +begin + NewNote(Sender); +end; + +//procedure NewHalf; +//begin +// NewNote; +//end; + +procedure NewNote(Sender: TScreenSing); +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Pet: integer; + Mozna: boolean; + Nowa: boolean; + Range: integer; + NoteHit:boolean; +begin +// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); +// beep; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do begin + + // analyze buffer + Sound[CP].AnalizujBufor; + + // adds some noise +// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; + + // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Czesci[0].Akt-1; + if SMin < 0 then SMin := 0; + SMax := Czesci[0].Akt; + + // check if we can add new note + Mozna := false; + SDet:=SMin; + for S := SMin to SMax do + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) + and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 + then begin + SDet := S; + Mozna := true; + Break; + end; + + S := SDet; + + + + + +// Czas.SzczytJest := true; +// Czas.Ton := 27; + + // gdy moze, to dodaje nute + if (Sound[CP].SzczytJest) and (Mozna) then begin + // operowanie na ostatniej nucie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + Sound[CP].Ton := Sound[CP].Ton - 12; + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + Sound[CP].Ton := Sound[CP].Ton + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin + Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + + // Half size Notes Patch + NoteHit := true; + + + if (Ini.LineBonus = 0) then + begin + // add points without LineBonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end + else + begin + // add points with Line Bonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then begin + Nowa := true; + // jezeli ostatnia ma ten sam ton + if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) + then Nowa := false; + // jezeli jest jakas nowa nuta na sprawdzanym beacie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then + Nowa := true; + + // dodawanie nowej nuty + if Nowa then begin + // nowa nuta + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNut := Player[CP].HighNut + 1; + SetLength(Player[CP].Nuta, Player[CP].IlNut); + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; + Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + + + // Half Note Patch + Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; + + + // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); + + end else begin + // przedluzenie nuty + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; + end; + + + // check for perfect note and then lit the star (on Draw) + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) + and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin + Player[CP].Nuta[Player[CP].HighNut].Perfect := true; + end; + + end;// else beep; // if S = SMax + + end; // if moze + end; // for CP +// Log.LogStatus('EndBeat', 'NewBeat'); + +//On Sentence End -> For LineBonus + SingBar +if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then +if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then + Sender.onSentenceEnd(sDet); + +end; + +procedure ClearScores(PlayerNum: integer); +begin + Player[PlayerNum].Score := 0; + Player[PlayerNum].ScoreI := 0; + Player[PlayerNum].ScoreLine := 0; + Player[PlayerNum].ScoreLineI := 0; + Player[PlayerNum].ScoreGolden := 0; + Player[PlayerNum].ScoreGoldenI := 0; + Player[PlayerNum].ScoreTotalI := 0; + + + //SingBar Mod + Player[PlayerNum].ScoreLast := 0; + Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts + Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts + //end SingBar Mod + + //PhrasenBonus - Line Bonus Mod + Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus + Player[PlayerNum].LineBonus_Alpha := 0; + Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; + Player[PlayerNum].LineBonus_TargetY := 30; + //PhrasenBonus - Line Bonus Mod End +end; + +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; + + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + begin + aPathVar := aLocation; + + If DirectoryExists(aPathVar) then + lWriteable := ForceDirectories(aPathVar) + else + lWriteable := false; + + if not lWriteable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; + +begin + + GamePath := ExtractFilePath(ParamStr(0)); + + initialize_path( LogPath , GamePath ); + initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); + initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); + initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); + initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); + initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); + initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); + initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); + initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); + + DecimalSeparator := ','; +end; + +end. + diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index e2e1f27e..b9ed47b4 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -1,731 +1,735 @@ -unit UMusic; - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - UCommon, - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - {$IFDEF useBASS} - bass, - {$ENDIF} - ULog, - USongs; - - -procedure InitializeSound; - -type - TSoundCard = record - Name: string; - Source: array of string; - end; - - TFFTData = array [0..256] of Single; - - TCustomSoundEntry = record - Filename : String; - Handle : hStream; - end; - - - TMusic = class - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - - - Loaded: boolean; - Loop: boolean; - public - Bass: hStream; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function Position: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal); - -end; - -const - RecordSystem = 1; - -type - TMuzyka = record - Path: string; - Start: integer; // start of song in ms - IlNut: integer; - DlugoscNut: integer; - end; - - TCzesci = record - Akt: integer; // aktualna czesc utworu do rysowania - High: integer; - Ilosc: integer; - Resolution: integer; - NotesGAP: integer; - Wartosc: integer; - Czesc: array of record - Start: integer; - StartNote: integer; - Lyric: string; - LyricWidth: real; - Koniec: integer; - BaseNote: integer; - HighNut: integer; - IlNut: integer; - TotalNotes: integer; - Nuta: array of record - Color: integer; - Start: integer; - Dlugosc: integer; - Ton: integer; - TonGamy: integer; - Tekst: string; - FreeStyle: boolean; - Wartosc: integer; // zwykla nuta x1, zlota nuta x2 - end; - end; - end; - - TCzas = record // wszystko, co dotyczy aktualnej klatki - OldBeat: integer; // poprzednio wykryty beat w utworze - AktBeat: integer; // aktualny beat w utworze - MidBeat: real; // dokladny AktBeat - - // now we use this for super synchronization! - // only used when analyzing voice - OldBeatD: integer; // poprzednio wykryty beat w utworze - AktBeatD: integer; // aktualny beat w utworze - MidBeatD: real; // dokladny AktBeatD - FracBeatD: real; // fractional part of MidBeatD - - // we use this for audiable clicks - OldBeatC: integer; // poprzednio wykryty beat w utworze - AktBeatC: integer; // aktualny beat w utworze - MidBeatC: real; // dokladny AktBeatC - FracBeatC: real; // fractional part of MidBeatC - - - OldCzesc: integer; // poprzednio wyswietlana czesc - // akt jest w czesci.akt - - Teraz: real; // aktualny czas w utworze - Razem: real; // caly czas utworu - end; - -var - Music: TMusic; - - // muzyka - Muzyka: TMuzyka; - - // czesci z nutami; - Czesci: array of TCzesci; - - // czas - Czas: TCzas; - - fHWND: Thandle; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -implementation - -uses - {$IFDEF FPC} - lclintf, - {$ENDIF} - UGraphic, - URecord, - UFiles, - UIni, - UMain, - UThemes; - -procedure InitializeSound; -begin - Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; - Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; -end; - -procedure TMusic.InitializePlayback; -var - Pet: integer; - S: integer; -begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB_lazarus find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - {$ENDIF} - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - Log.LogStatus('Loading Sounds', 'Music Initialize'); - - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TMusic.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TMusic.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); - {$ENDIF} -end; - -procedure TMusic.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - //Set Volume - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); - {$ENDIF} -end; - -procedure TMusic.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TMusic.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - {$ENDIF} - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TMusic.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TMusic.MoveTo(Time: real); -var - bytes: integer; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); - {$ENDIF} -end; - -procedure TMusic.Play; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; - {$ENDIF} -end; - -procedure TMusic.Pause; //Pause Mod -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; - {$ENDIF} -end; - -procedure TMusic.Stop; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); - {$ENDIF} -end; - -procedure TMusic.Close; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); - {$ENDIF} -end; - -function TMusic.Length: real; -var - bytes: integer; -begin - Result := 60; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); - {$ENDIF} -end; - -function TMusic.Position: real; -var - bytes: integer; -begin - Result := 0; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); - {$ENDIF} -end; - -function TMusic.Finished: boolean; -begin - Result := false; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; - {$ENDIF} -end; - -procedure TMusic.PlayStart; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); - {$ENDIF} -end; - -procedure TMusic.PlayBack; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then - {$ENDIF} -end; - -procedure TMusic.PlaySwoosh; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); - {$ENDIF} -end; - -procedure TMusic.PlayChange; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); - {$ENDIF} -end; - -procedure TMusic.PlayOption; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); - {$ENDIF} -end; - -procedure TMusic.PlayClick; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); - {$ENDIF} -end; - -procedure TMusic.PlayDrum; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); - {$ENDIF} -end; - -procedure TMusic.PlayHihat; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); - {$ENDIF} -end; - -procedure TMusic.PlayClap; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); - {$ENDIF} -end; - -procedure TMusic.PlayShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); - {$ENDIF} -end; - -procedure TMusic.StopShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); - {$ENDIF} -end; - -procedure TMusic.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; -end; - -procedure TMusic.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; - -end; - -//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if not BASS_RecordInit(RecordI) then begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; - - {$ENDIF} -end; - -procedure TMusic.StopCard(Card: byte); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; - {$ENDIF} -end; - -function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - {$ENDIF} - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TMusic.GetFFTData: TFFTData; -var -Data: TFFTData; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - //Result := Data; - - {$ENDIF} -end; - -function TMusic.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TMusic.PlayCustomSound(const Index: Cardinal); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); - - {$ENDIF} -end; - - -end. +unit UMusic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + UCommon, + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + {$IFDEF useBASS} + bass, + {$ENDIF} + ULog, + USongs; + + +procedure InitializeSound; + +type + TSoundCard = record + Name: string; + Source: array of string; + end; + + TFFTData = array [0..256] of Single; + + TCustomSoundEntry = record + Filename : String; + Handle : hStream; + end; + + + TMusic = class + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + + + Loaded: boolean; + Loop: boolean; + public + Bass: hStream; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal); + +end; + +const + RecordSystem = 1; + +type + TMuzyka = record + Path: string; + Start: integer; // start of song in ms + IlNut: integer; + DlugoscNut: integer; + end; + + PLine = ^TLine; + TLine = record + Start: integer; + StartNote: integer; + Lyric: string; + LyricWidth: real; + Koniec: integer; + BaseNote: integer; + HighNut: integer; + IlNut: integer; + TotalNotes: integer; + Nuta: array of record + Color: integer; + Start: integer; + Dlugosc: integer; + Ton: integer; + TonGamy: integer; + Tekst: string; + FreeStyle: boolean; + Wartosc: integer; // zwykla nuta x1, zlota nuta x2 + end; + end; + ALine = array of TLine; + + TCzesci = record + Akt: integer; // aktualna czesc utworu do rysowania + High: integer; + Ilosc: integer; + Resolution: integer; + NotesGAP: integer; + Wartosc: integer; + Czesc: ALine; + end; + + TCzas = record // wszystko, co dotyczy aktualnej klatki + OldBeat: integer; // poprzednio wykryty beat w utworze + AktBeat: integer; // aktualny beat w utworze + MidBeat: real; // dokladny AktBeat + + // now we use this for super synchronization! + // only used when analyzing voice + OldBeatD: integer; // poprzednio wykryty beat w utworze + AktBeatD: integer; // aktualny beat w utworze + MidBeatD: real; // dokladny AktBeatD + FracBeatD: real; // fractional part of MidBeatD + + // we use this for audiable clicks + OldBeatC: integer; // poprzednio wykryty beat w utworze + AktBeatC: integer; // aktualny beat w utworze + MidBeatC: real; // dokladny AktBeatC + FracBeatC: real; // fractional part of MidBeatC + + + OldCzesc: integer; // poprzednio wyswietlana czesc + // akt jest w czesci.akt + + Teraz: real; // aktualny czas w utworze + Razem: real; // caly czas utworu + end; + +var + Music: TMusic; + + // muzyka + Muzyka: TMuzyka; + + // czesci z nutami; + Czesci: array of TCzesci; + + // czas + Czas: TCzas; + + fHWND: Thandle; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + UGraphic, + URecord, + UFiles, + UIni, + UMain, + UThemes; + +procedure InitializeSound; +begin + Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; + Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; +end; + +procedure TMusic.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + {$ENDIF} + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TMusic.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TMusic.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); + {$ENDIF} +end; + +procedure TMusic.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + //Set Volume + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + {$ENDIF} +end; + +procedure TMusic.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TMusic.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + {$ENDIF} + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TMusic.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TMusic.MoveTo(Time: real); +var + bytes: integer; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); + {$ENDIF} +end; + +procedure TMusic.Play; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; + {$ENDIF} +end; + +procedure TMusic.Pause; //Pause Mod +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; + {$ENDIF} +end; + +procedure TMusic.Stop; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); + {$ENDIF} +end; + +procedure TMusic.Close; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); + {$ENDIF} +end; + +function TMusic.Length: real; +var + bytes: integer; +begin + Result := 60; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); + {$ENDIF} +end; + +function TMusic.Position: real; +var + bytes: integer; +begin + Result := 0; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); + {$ENDIF} +end; + +function TMusic.Finished: boolean; +begin + Result := false; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; + {$ENDIF} +end; + +procedure TMusic.PlayStart; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); + {$ENDIF} +end; + +procedure TMusic.PlayBack; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then + {$ENDIF} +end; + +procedure TMusic.PlaySwoosh; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); + {$ENDIF} +end; + +procedure TMusic.PlayChange; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); + {$ENDIF} +end; + +procedure TMusic.PlayOption; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); + {$ENDIF} +end; + +procedure TMusic.PlayClick; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); + {$ENDIF} +end; + +procedure TMusic.PlayDrum; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); + {$ENDIF} +end; + +procedure TMusic.PlayHihat; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); + {$ENDIF} +end; + +procedure TMusic.PlayClap; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); + {$ENDIF} +end; + +procedure TMusic.PlayShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); + {$ENDIF} +end; + +procedure TMusic.StopShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); + {$ENDIF} +end; + +procedure TMusic.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TMusic.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if not BASS_RecordInit(RecordI) then begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; + + {$ENDIF} +end; + +procedure TMusic.StopCard(Card: byte); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; + {$ENDIF} +end; + +function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + {$ENDIF} + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end else begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TMusic.GetFFTData: TFFTData; +var +Data: TFFTData; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + //Result := Data; + + {$ENDIF} +end; + +function TMusic.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TMusic.PlayCustomSound(const Index: Cardinal); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); + + {$ENDIF} +end; + + +end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 6436ee39..1e102987 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -18,6 +18,10 @@ type B: single; end; + TRGBA = record + R, G, B, A: Double; + end; + TThemeBackground = record Tex: string; end; -- cgit v1.2.3 From 4e1c6d261a7b51c58f261c5642bec17988aa549f Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 20 Sep 2007 07:38:21 +0000 Subject: forgot something ^^; git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@413 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.bak.pas | 418 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 418 insertions(+) create mode 100644 Game/Code/Classes/ULyrics.bak.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.bak.pas b/Game/Code/Classes/ULyrics.bak.pas new file mode 100644 index 00000000..e432f7e5 --- /dev/null +++ b/Game/Code/Classes/ULyrics.bak.pas @@ -0,0 +1,418 @@ +unit ULyrics.bak; + +interface +uses SysUtils, OpenGL12, UMusic, UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + + //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + PlayerIconTex: array[0..5] of array [0..1] of TTexture; + + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + + procedure DrawPlayerIcons; + public + //Array containing Players Singing the Next Sentence + // 1: Player 1 Active + // 2: Player 2 Active + // 3: Player 3 Active + PlayersActive: Byte; + + //Dark or Light Colors + Enabled: Boolean; + + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + constructor Create; + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture, Math, USkins; + +Constructor TLyric.Create; +var + I: Integer; +begin + //Only 2 Players for now + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + PlayersActive := Trunc(Power(2, 1)) + 1; +end; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + Word[SelectedI].Done := 0; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; // new + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TLyric.DrawPlayerIcons; +begin + +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. -- cgit v1.2.3 From fb923e76a9d728805670c58a8eece411fb2b0b02 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 09:28:52 +0000 Subject: modified to make it build blindys current work. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@414 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 09bbc1c9..7c0ef57e 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -312,7 +312,7 @@ end; procedure Initialize3D (Title: string); var // Icon: TIcon; - Res: TResourceStream; +// Res: TResourceStream; ISurface: PSDL_Surface; Pixel: PByteArray; I: Integer; -- cgit v1.2.3 From 3c41f973b397b718135a7713c7501607812b0192 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 09:42:35 +0000 Subject: renamed Ulyrics.bak.pas hack to Ulyrics_bak.pas for lazarus compatiblity. minor changes to get code base compiling in Lazarus(win) and Delphi git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@415 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 268 ++++++++++++------------ Game/Code/Classes/ULyrics.bak.pas | 418 ------------------------------------- Game/Code/Classes/ULyrics.pas | 7 + Game/Code/Classes/ULyrics_bak.pas | 428 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 571 insertions(+), 550 deletions(-) delete mode 100644 Game/Code/Classes/ULyrics.bak.pas create mode 100644 Game/Code/Classes/ULyrics_bak.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b7ddd7ba..b572a768 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,132 +1,136 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses - -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -//function AllocateHWnd(Method: TWndMethod): HWND; -//procedure DeallocateHWnd(Wnd: HWND); - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; -{$ENDIF} - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -implementation - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -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} - - -{$IFDEF FPC} - -function MaxValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result < Data[I] then - Result := Data[I]; -end; - -function MinValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result > Data[I] then - Result := Data[I]; -end; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin -RandomRange := Random(aMax-aMin) + aMin ; -end; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{ -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -} - -{$ENDIF} - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + +{$IFDEF Win32} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(Wnd: HWND); +{$ENDIF} + +{$ENDIF} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +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} + + +{$IFDEF FPC} + +function MaxValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result < Data[I] then + Result := Data[I]; +end; + +function MinValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result > Data[I] then + Result := Data[I]; +end; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin +RandomRange := Random(aMax-aMin) + aMin ; +end; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF Win32} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} + +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/ULyrics.bak.pas b/Game/Code/Classes/ULyrics.bak.pas deleted file mode 100644 index e432f7e5..00000000 --- a/Game/Code/Classes/ULyrics.bak.pas +++ /dev/null @@ -1,418 +0,0 @@ -unit ULyrics.bak; - -interface -uses SysUtils, OpenGL12, UMusic, UTexture; - -type - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - Scale: real; - Done: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; - end; - - TLyric = class - private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - ScaleR: real; - StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left - FontStyleI: integer; // font number - Word: array of TWord; - - //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled - PlayerIconTex: array[0..5] of array [0..1] of TTexture; - - procedure SetX(Value: real); - procedure SetY(Value: real); - function GetClientX: real; - procedure SetAlign(Value: integer); - function GetSize: real; - procedure SetSize(Value: real); - procedure SetSelected(Value: integer); - procedure SetDone(Value: real); - procedure SetScale(Value: real); - procedure SetStyle(Value: integer); - procedure SetFStyle(Value: integer); - procedure Refresh; - - procedure DrawNormal(W: integer); - procedure DrawPlain(W: integer); - procedure DrawScaled(W: integer); - procedure DrawSlide(W: integer); - - procedure DrawPlayerIcons; - public - //Array containing Players Singing the Next Sentence - // 1: Player 1 Active - // 2: Player 2 Active - // 3: Player 3 Active - PlayersActive: Byte; - - //Dark or Light Colors - Enabled: Boolean; - - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - Text: string; // LCD - - constructor Create; - published - property X: real write SetX; - property Y: real write SetY; - property ClientX: real read GetClientX; - property Align: integer write SetAlign; - property Size: real read GetSize write SetSize; - property Selected: integer read SelectedI write SetSelected; - property Done: real write SetDone; - property Scale: real write SetScale; - property Style: integer write SetStyle; - property FontStyle: integer write SetFStyle; - procedure AddWord(Text: string); - procedure AddCzesc(NrCzesci: integer); - - function SelectedLetter: integer; // LCD - function SelectedLength: integer; // LCD - - procedure Clear; - procedure Draw; - - end; - -var - Lyric: TLyric; - -implementation -uses TextGL, UGraphic, UDrawTexture, Math, USkins; - -Constructor TLyric.Create; -var - I: Integer; -begin - //Only 2 Players for now - For I := 0 to 1 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - end; - PlayersActive := Trunc(Power(2, 1)) + 1; -end; - -procedure TLyric.SetX(Value: real); -begin - XR := Value; -end; - -procedure TLyric.SetY(Value: real); -begin - YR := Value; -end; - -function TLyric.GetClientX: real; -begin - Result := Word[0].X; -end; - -procedure TLyric.SetAlign(Value: integer); -begin - AlignI := Value; -// if AlignInt = 0 then beep; -end; - -function TLyric.GetSize: real; -begin - Result := SizeR; -end; - -procedure TLyric.SetSize(Value: real); -begin - SizeR := Value; -end; - -procedure TLyric.SetSelected(Value: integer); -var - W: integer; -begin - if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - Word[SelectedI].Selected := false; - Word[SelectedI].ColR := ColR; - Word[SelectedI].ColG := ColG; - Word[SelectedI].ColB := ColB; - Word[SelectedI].Done := 0; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - Word[Value].Selected := true; - Word[Value].ColR := ColSR; - Word[Value].ColG := ColSG; - Word[Value].ColB := ColSB; - Word[Value].Scale := ScaleR; - end; - end; - - if (StyleI = 1) or (StyleI = 3) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - for W := SelectedI to High(Word) do begin - Word[W].Selected := false; - Word[W].ColR := ColR; - Word[W].ColG := ColG; - Word[W].ColB := ColB; - Word[W].Done := 0; - end; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - for W := 0 to Value do begin - Word[W].Selected := true; - Word[W].ColR := ColSR; - Word[W].ColG := ColSG; - Word[W].ColB := ColSB; - Word[W].Scale := ScaleR; - Word[W].Done := 1; - end; - end; - end; - - Refresh; -end; - -procedure TLyric.SetDone(Value: real); -var - W: integer; -begin - W := SelectedI; - if W > -1 then - Word[W].Done := Value; -end; - -procedure TLyric.SetScale(Value: real); -begin - ScaleR := Value; -end; - -procedure TLyric.SetStyle(Value: integer); -begin - StyleI := Value; -end; - -procedure TLyric.SetFStyle(Value: integer); -begin - FontStyleI := Value; -end; - -procedure TLyric.AddWord(Text: string); -var - WordNum: integer; -begin - WordNum := Length(Word); - SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin - Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - end; - - Word[WordNum].Y := YR; - Word[WordNum].Size := SizeR; - Word[WordNum].FontStyle := FontStyleI; // new - SetFontStyle(FontStyleI); - SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(pchar(Text)); - Word[WordNum].Text := Text; - Word[WordNum].ColR := ColR; - Word[WordNum].ColG := ColG; - Word[WordNum].ColB := ColB; - Word[WordNum].Scale := 1; - Word[WordNum].Done := 0; - Word[WordNum].Italic := Italic; - - Refresh; -end; - -procedure TLyric.AddCzesc(NrCzesci: integer); -var - N: integer; -begin - Clear; - for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin - Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; - AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); - Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; - end; - Selected := -1; -end; - -procedure TLyric.Clear; -begin -{ ColR := Skin_FontR; - ColG := Skin_FontG; - ColB := Skin_FontB;} - SetLength(Word, 0); - Text := ''; - SelectedI := -1; -end; - -procedure TLyric.Refresh; -var - W: integer; - TotWidth: real; -begin - if AlignI = 1 then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; - - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; - end; -end; - -procedure TLyric.DrawPlayerIcons; -begin - -end; - -procedure TLyric.Draw; -var - W: integer; -begin - case StyleI of - 0: - begin - for W := 0 to High(Word) do - DrawNormal(W); - end; - 1: - begin - for W := 0 to High(Word) do - DrawPlain(W); - end; - 2: // zoom - begin - for W := 0 to High(Word) do - if not Word[W].Selected then - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then - DrawScaled(W); - end; - 3: // slide - begin - for W := 0 to High(Word) do begin - if not Word[W].Selected then - DrawNormal(W) - else - DrawSlide(W); - end; - end; - 4: // ball - begin - for W := 0 to High(Word) do - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then begin - Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; - Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); - Tex_Ball.W := 20; - Tex_Ball.H := 20; - DrawTexture(Tex_Ball); - end; - end; - end; // case -end; - -procedure TLyric.DrawNormal(W: integer); -begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawPlain(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - - if D = 0 then - glColor3f(ColR, ColG, ColB) - else - glColor3f(ColSR, ColSG, ColSB); - - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawScaled(W: integer); -var - D: real; -begin - // previous plus dynamic scaling effect - D := 1-Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); - SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)) -end; - -procedure TLyric.DrawSlide(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); -end; - -function TLyric.SelectedLetter; // LCD -var - W: integer; -begin - Result := 1; - - for W := 0 to SelectedI-1 do - Result := Result + Length(Word[W].Text); -end; - -function TLyric.SelectedLength: integer; // LCD -begin - Result := Length(Word[SelectedI].Text); -end; - -end. diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 5cf6114d..1c2795ce 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -1,6 +1,13 @@ unit ULyrics; interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + uses OpenGL12, UTexture, UThemes, UMusic; type diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas new file mode 100644 index 00000000..43fa46f5 --- /dev/null +++ b/Game/Code/Classes/ULyrics_bak.pas @@ -0,0 +1,428 @@ +unit ULyrics_bak; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses SysUtils, + OpenGL12, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + + //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + PlayerIconTex: array[0..5] of array [0..1] of TTexture; + + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + + procedure DrawPlayerIcons; + public + //Array containing Players Singing the Next Sentence + // 1: Player 1 Active + // 2: Player 2 Active + // 3: Player 3 Active + PlayersActive: Byte; + + //Dark or Light Colors + Enabled: Boolean; + + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + constructor Create; + + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture, Math, USkins; + +Constructor TLyric.Create; +var + I: Integer; +begin + //Only 2 Players for now + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + PlayersActive := Trunc(Power(2, 1)) + 1; +end; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + Word[SelectedI].Done := 0; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; // new + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TLyric.DrawPlayerIcons; +begin + +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. -- cgit v1.2.3 From a1c2876fb12cfc860044f00210f69a9bdc2cf687 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 10:35:02 +0000 Subject: minor fixes for lazarus build.. forgot file... oops.. :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@416 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 66 +- Game/Code/Classes/UTexture.pas | 2143 +++++++++++++++++++++------------------- Game/Code/Classes/Ulazjpeg.pas | 118 +++ 3 files changed, 1259 insertions(+), 1068 deletions(-) create mode 100644 Game/Code/Classes/Ulazjpeg.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 7c0ef57e..7094c0f9 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -66,9 +66,8 @@ type end; var - Screen: PSDL_Surface; - - LoadingThread: PSDL_Thread; + Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; Mutex: PSDL_Mutex; RenderW: integer; @@ -256,41 +255,44 @@ var begin // zaladowanie tekstur Log.LogStatus('Loading Textures', 'LoadTextures'); + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? // P1-6 - for P := 1 to 6 do begin + for P := 1 to 6 do + begin LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); - - Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); - Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); - Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); end; Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); //eoa TimeBar mod //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); - Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); - Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); //end Singbar Mod //Line Bonus PopUp @@ -370,6 +372,7 @@ begin Log.BenchmarkEnd(2); Log.LogBenchmark('--> Loading Fonts', 2); } + Log.BenchmarkStart(2); Display := TDisplay.Create; SDL_EnableUnicode(1); @@ -378,7 +381,11 @@ begin Log.LogStatus('Loading Screens', 'Initialize3D'); Log.BenchmarkStart(3); + // Show the Loading Screen ------------- LoadLoadingScreen; + + + // now that we have something to display while loading, // start thread that loads the rest of ultrastar // Mutex := SDL_CreateMutex; @@ -414,7 +421,7 @@ begin //SDL_WaitThread(LoadingThread, I); // SDL_DestroyMutex(Mutex); - Display.ActualScreen^.FadeTo(@ScreenMain); + Display.ActualScreen^.FadeTo( @ScreenMain ); Log.BenchmarkEnd(2); Log.LogBenchmark('--> Loading Screens', 2); @@ -486,12 +493,17 @@ begin // SDL_SetRefreshrate(85); // SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + begin screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) - else begin + end + else + begin screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); SDL_ShowCursor(0); end; - if (screen = nil) then begin + + if (screen = nil) then + begin Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); exit; end; @@ -512,10 +524,14 @@ procedure LoadLoadingScreen; begin ScreenLoading := TScreenLoading.Create; ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + swapbuffers; + ScreenLoading.Draw; Display.Draw; + SwapBuffers; end; diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 1bc4c558..364bbcc8 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1043 +1,1100 @@ -unit UTexture; - -// Plain (alpha = 1) -// Transparent -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - JPEG, - PNGImage, - {$ENDIF} - Graphics, - UCommon, - UThemes; - - - {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - {$ENDIF} - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - end; - -var - lasthue: double; - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - - TexOrigW: integer; - TexOrigH: integer; - TexNewW: integer; - TexNewH: integer; - - TexFitW: integer; - TexFitH: integer; // new for limit - - TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) - TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) - TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) - TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - - -implementation -uses ULog, DateUtils, UCovers, StrUtils; - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - // find texture entry - T := FindTexture(Name); - - if T = -1 then begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin - // load texture - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - - end; - - if FromCache and Covers.CoverExists(Name) then begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -// expects: src, dst: pointers to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0] := src[0]/255; - clr[1] := src[1]/255; - clr[2] := src[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=src[3]; - end; -end; - -// expects: src: $rrggbb -// dst: pointer to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0]:=((src shr 16) and $ff)/255; - clr[1]:=((src shr 8) and $ff)/255; - clr[2]:=(src and $ff)/255; - //calculate luminance and saturation from rgb - hls[1]:=maxvalue(clr); //l:=... - delta:=hls[1]-minvalue(clr); - if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=255; - end; -end; -//returns hue within range [0.0-6.0) -function col2h(Color:Cardinal):double; -var - clr,hls: array[0..2] of double; - delta: double; -begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; -end; - - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - Res: TResourceStream; - TextureB: TBitmap; - TextureJ: TJPEGImage; - {$IFNDEF FPC} - TexturePNG: TPNGObject; - {$ENDIF} - - TextureAlpha: array of byte; - AlphaPtr: PByte; - TransparentColor: TColor; - PixelColor: TColor; - - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; - SkipX: integer; - myAlpha: Real; - myRGBABitmap: array of byte; - RGBPtr: PByte; - myHue: Double; -begin - {$IFNDEF FPC} // TODO : JB_lazarus eeeew this is a nasty one... - // but lazarus implementation scanlines is different :( - // need to implement as per - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 - // http://wiki.lazarus.freepascal.org/Developing_with_Graphics - Log.BenchmarkStart(4); - Mipmapping := true; - - if FromRegistry then begin - try - Res := TResourceStream.Create(HInstance, Identifier, Format); - except - beep; - Exit; - end; - end; - - // filetype "detection" - if (not FromRegistry) and (FileExists(Identifier)) then begin - Format:=''; - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - end; -// else Format:='JPG'; -// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; - - if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; - - if Format = 'BMP' then - begin - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end - else - if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end - else if Format = 'PNG' then - begin - {$IFNDEF FPC} - // TODO : JB_lazarus - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TexturePNG); - // transparent png hack start (part 1 of 2) - if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then - begin - setlength(TextureAlpha, TextureB.Width*TextureB.Height); - setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); - if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or - (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then - begin - // i would have preferred english variables here but i use Position because i'm lazy - for Position := 0 to TextureB.Height - 1 do - begin - AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); - RGBPtr:=PByte(TexturePNG.Scanline[Position]); - for Position2 := 0 to TextureB.Width - 1 do - begin - TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; - MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; -// Inc(RGBPtr); - Inc(AlphaPtr); - end; - end; - end; - end else - setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) - // transparent png hack end - TexturePNG.Free; - {$ENDIF} - end; - - if FromRegistry then Res.Free; - - if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver - Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); - Result.TexNum := -1; - end else begin - - glGenTextures(1, ActTex); - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - if Typ = 'Plain' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - - // copy and process pixeldata - TextureB.PixelFormat := pf24bit; -{ if (TextureB.PixelFormat = pf8bit) then begin - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD24[Position*TexNewW + Position2+1, 1] := Pix; - TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - end; - end; - end;} - if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - end else begin - // limit - TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrigH; - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, - Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time - - TexNewW := Limit; - TexNewH := Limit; - TexOrigW := Limit; - TexOrigH := Limit; - end; - - // creating cache mipmap - if CreateCacheMipmap then begin - if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin - // texture only uses some of it's space. there's a need for resize to fit full size - // and get best quality - TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrigH; - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; - TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; - TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - - end else begin - // texture fits perfectly - gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - end; - end; - - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Error > 0 then beep; - end - end; - - if Typ = 'Transparent' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - // ,- part of transparent png hack - if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) - TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; - end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; - TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; - end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); - TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); - TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); - TextureD32[Position*TexNewW + Position2+1, 4] := 255; - end; - end; - end; - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - -// The new awesomeness of colorized pngs starts here -// We're the first who had this feature, so give credit when you copy+paste :P - if Typ = 'Colorized' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - myHue:=col2h(Col); - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then - ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue) - else - ColorizeCopy(Pix, - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue); - end; - end; - - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -// eoa COLORIZE - - if Typ = 'Transparent Range' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - - if Typ = 'Font' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Outline' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Outline 2' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - - if Typ = 'Arrow' then begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - TextureB.Free; - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Identifier; - - end; - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - end; // logerror - {$ENDIF} -end; - -{procedure ResizeTexture(s: pbytearray; d: pbytearray); -var - Position: integer; - Position2: integer; -begin - for Position := 0 to TexNewH*4-1 do - for Position2 := 0 to TexNewW-1 do - d[Position*TexNewW + Position2] := 0; - - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; - d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; - d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; - d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; - end; - end; -end;} - -{procedure SetTexture(p: pointer); -begin - glGenTextures(1, Tekstur); - glBindTexture(GL_TEXTURE_2D, Tekstur); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); -end;} - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg - -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -end. +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFDEF FPC} + ulazjpeg, + {$ELSE} + JPEG, + PNGImage, + {$ENDIF} + Graphics, + UCommon, + UThemes; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + {$ENDIF} + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + lasthue: double; + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + + TexOrigW: integer; + TexOrigH: integer; + TexNewW: integer; + TexNewH: integer; + + TexFitW: integer; + TexFitH: integer; // new for limit + + TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) + TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) + TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) + TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers, StrUtils; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + // find texture entry + T := FindTexture(Name); + + if T = -1 then begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin + // load texture + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + + end; + + if FromCache and Covers.CoverExists(Name) then begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +// expects: src, dst: pointers to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0] := src[0]/255; + clr[1] := src[1]/255; + clr[2] := src[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=src[3]; + end; +end; + +// expects: src: $rrggbb +// dst: pointer to r,g,b,a +// hue: new hue within range [0.0-6.0) +procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; +var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; +begin + hls[0]:=hue; + + clr[0]:=((src shr 16) and $ff)/255; + clr[1]:=((src shr 8) and $ff)/255; + clr[2]:=(src and $ff)/255; + //calculate luminance and saturation from rgb + hls[1]:=maxvalue(clr); //l:=... + delta:=hls[1]-minvalue(clr); + if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... + // calc new rgb from our hls (h from color, l ans s from pixel) +// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + dst[0]:=floor(255*clr[0]); + dst[1]:=floor(255*clr[1]); + dst[2]:=floor(255*clr[2]); + dst[3]:=255; + end; +end; +//returns hue within range [0.0-6.0) +function col2h(Color:Cardinal):double; +var + clr,hls: array[0..2] of double; + delta: double; +begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; +end; + + +function TTextureUnit.LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; +begin + aSourceStream.position := 0; + boolean := aBMP.LoadFromStream( aSourceStream ) > 0; +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + Res: TResourceStream; + TextureB: TBitmap; + TextureJ: TJPEGImage; + {$IFNDEF FPC} + TexturePNG: TPNGObject; + {$ENDIF} + + TextureAlpha: array of byte; + AlphaPtr: PByte; + TransparentColor: TColor; + PixelColor: TColor; + + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; + SkipX: integer; + myAlpha: Real; + myRGBABitmap: array of byte; + RGBPtr: PByte; + myHue: Double; + + lTextureStream : TStream; +begin + + Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); +// {$IFNDEF FPC} + // TODO : JB_lazarus eeeew this is a nasty one... + // but lazarus implementation scanlines is different :( + // need to implement as per + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 + // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 + // http://wiki.lazarus.freepascal.org/Developing_with_Graphics + Log.BenchmarkStart(4); + Mipmapping := true; + + if FromRegistry then + begin + try +// Res := TResourceStream.Create(HInstance, Identifier, Format); + lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); + + // TODO : Where does the format come from + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + end + else + begin + if ( FileExists(Identifier) ) then + begin + // Get the File Extension... + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + lTextureStream := TFileStream.create( Identifier , fmOpenRead ); + end; + end; + + if FromRegistry or + ((not FromRegistry) and FileExists(Identifier)) then + begin + TextureB := TBitmap.Create; + + if Format = 'BMP' then + begin + LoadBitmap( aSourceStream : TStream; TextureB ); + + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); + end + else + if Format = 'JPG' then + begin + TextureJ := TJPEGImage.Create; + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TextureJ); + TextureJ.Free; + end + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus - fix this for lazarus.. + TexturePNG := TPNGObject.Create; + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TexturePNG); + // transparent png hack start (part 1 of 2) + if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then + begin + setlength(TextureAlpha, TextureB.Width*TextureB.Height); + setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); + if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or + (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then + begin + // i would have preferred english variables here but i use Position because i'm lazy + for Position := 0 to TextureB.Height - 1 do + begin + AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); + RGBPtr:=PByte(TexturePNG.Scanline[Position]); + for Position2 := 0 to TextureB.Width - 1 do + begin + TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; + MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; + Inc(RGBPtr); + MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; +// Inc(RGBPtr); + Inc(AlphaPtr); + end; + end; + end; + end else + setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) + // transparent png hack end + TexturePNG.Free; + {$ENDIF} + end; + + if FromRegistry then Res.Free; + + if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver + Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Result.TexNum := -1; + end else begin + + glGenTextures(1, ActTex); + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + if Typ = 'Plain' then + begin + {$IFNDEF FPC} + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + + // copy and process pixeldata + TextureB.PixelFormat := pf24bit; +{ if (TextureB.PixelFormat = pf8bit) then begin + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD24[Position*TexNewW + Position2+1, 1] := Pix; + TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + end; + end; + end;} + if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin + if (TextureB.PixelFormat = pf24bit) then begin + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; + end; + end; + end; + end else begin + // limit + TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrigH; + if (TextureB.PixelFormat = pf24bit) then begin + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; + TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; + TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; + end; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, + Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time + + TexNewW := Limit; + TexNewH := Limit; + TexOrigW := Limit; + TexOrigH := Limit; + end; + + // creating cache mipmap + if CreateCacheMipmap then begin + if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin + // texture only uses some of it's space. there's a need for resize to fit full size + // and get best quality + TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage + SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image + + TexFitH := TexOrigH; + for Position := 0 to TexOrigH-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TexOrigW-1 do begin + TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; + TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; + TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; + end; + end; + gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + + end else begin + // texture fits perfectly + gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, + Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time + end; + end; + + glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + if Error > 0 then beep; + end + {$ENDIF} + end; + + if Typ = 'Transparent' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + // ,- part of transparent png hack + if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) + TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; + TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; + end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; + TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; + TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; + TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; + TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; + end else begin + TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); + TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); + TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); + TextureD32[Position*TexNewW + Position2+1, 4] := 255; + end; + end; + end; + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + +// The new awesomeness of colorized pngs starts here +// We're the first who had this feature, so give credit when you copy+paste :P + if Typ = 'Colorized' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + + myHue:=col2h(Col); + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then + ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue) + else + ColorizeCopy(Pix, + @TextureD32[Position*TexNewW + Position2+1, 1], + myHue); + end; + end; + + setlength(TextureAlpha,0); + setlength(MyRGBABitmap,0); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +// eoa COLORIZE + + if Typ = 'Transparent Range' then begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + end; + + if Typ = 'Font' then + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + {$ENDIF} + end; + + if Typ = 'Font Outline' then + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + {$ENDIF} + end; + + if Typ = 'Font Outline 2' then + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + {$ENDIF} + end; + + if Typ = 'Font Black' then + begin + {$IFNDEF FPC} + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + {$ENDIF} + end; + + if Typ = 'Alpha Black Colored' then + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + {$ENDIF} + end; + + if Typ = 'Font Gray' then + begin + {$IFNDEF FPC} + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); +{ if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end;} + {$ENDIF} + end; + + if Typ = 'Arrow' then + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + {$ENDIF} + end; + + if Typ = 'Note Plain' then + begin + {$IFNDEF FPC} + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + {$ENDIF} + end; + + if Typ = 'Note Transparent' then + begin + {$IFNDEF FPC} + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + {$ENDIF} + end; + + TextureB.Free; + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Identifier; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + end; // logerror +// {$ENDIF} +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Position: integer; + Position2: integer; +begin + for Position := 0 to TexNewH*4-1 do + for Position2 := 0 to TexNewW-1 do + d[Position*TexNewW + Position2] := 0; + + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; + d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; + d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; + d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +begin + glGenTextures(1, Tekstur); + glBindTexture(GL_TEXTURE_2D, Tekstur); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); +end;} + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg + +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas new file mode 100644 index 00000000..1f6d8b99 --- /dev/null +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -0,0 +1,118 @@ +{ Copyright (C) 2003 Mattias Gaertner + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit Ulazjpeg; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG; + +type + TJPEGQualityRange = TFPJPEGCompressionQuality; + TJPEGPerformance = TJPEGReadPerformance; + + TJPEGImage = class(TFPImageBitmap) + private + FPerformance: TJPEGPerformance; + FProgressiveEncoding: boolean; + FQuality: TJPEGQualityRange; + protected + procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; + procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; + procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; + public + constructor Create; override; + class function GetFileExtensions: string; override; + class function GetDefaultFPReader: TFPCustomImageReaderClass; override; + class function GetDefaultFPWriter: TFPCustomImageWriterClass; override; + public + property CompressionQuality: TJPEGQualityRange read FQuality write FQuality; + property ProgressiveEncoding: boolean read FProgressiveEncoding; + property Performance: TJPEGPerformance read FPerformance write FPerformance; + end; + +const + DefaultJPEGMimeType = 'image/jpeg'; + + +implementation + + +{ TJPEGImage } + +procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + JPEGReader.Performance:=Performance; + end; + inherited InitFPImageReader(ImgReader); +end; + +procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + FProgressiveEncoding:=JPEGReader.ProgressiveEncoding; + end; + inherited FinalizeFPImageReader(ImgReader); +end; + +procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); +var + JPEGWriter: TFPWriterJPEG; +begin + if ImgWriter is TFPWriterJPEG then begin + JPEGWriter:=TFPWriterJPEG(ImgWriter); + if JPEGWriter<>nil then ; + JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; + JPEGWriter.CompressionQuality:=CompressionQuality; + end; + inherited InitFPImageWriter(ImgWriter); +end; + +class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; +begin + Result:=TFPReaderJPEG; +end; + +class function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass; +begin + Result:=TFPWriterJPEG; +end; + +constructor TJPEGImage.Create; +begin + inherited Create; + FPerformance:=jpBestQuality; + FProgressiveEncoding:=false; + FQuality:=75; +end; + +class function TJPEGImage.GetFileExtensions: string; +begin + Result:='jpg;jpeg'; +end; + +end. + -- cgit v1.2.3 From efef73dfde7de1692afb9aa8a9d51dcafc59fbb2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 10:53:12 +0000 Subject: started re-factoring TTextureUnit.LoadTexture only done BPM and JPEG for now. will do more as I add support for it to lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@418 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 69 +++++++++++++++++++++++------------------- 1 file changed, 38 insertions(+), 31 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 364bbcc8..e7038e78 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -90,7 +90,8 @@ type TTextureUnit = class private - function LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; + function LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; + function LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; public Limit: integer; CreateCacheMipmap: boolean; @@ -311,12 +312,40 @@ begin end; -function TTextureUnit.LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; +function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; begin - aSourceStream.position := 0; - boolean := aBMP.LoadFromStream( aSourceStream ) > 0; + result := false; + try + aSourceStream.position := 0; + aIMG.LoadFromStream( aSourceStream ); + finally + result := aSourceStream.position > 0; + end; +end; + +function TTextureUnit.LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; +var + TextureJ: TJPEGImage; +begin + result := false; + try + aSourceStream.position := 0; + + TextureJ := TJPEGImage.Create; + try + TextureJ.LoadFromStream( aSourceStream ); + aIMG.Assign(TextureJ); + finally + TextureJ.Free; + end; + finally + result := aSourceStream.position > 0; + end; end; + + + function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; @@ -381,38 +410,16 @@ begin end; end; - if FromRegistry or - ((not FromRegistry) and FileExists(Identifier)) then +// if FromRegistry or +// ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; + TextureB := TBitmap.Create; if Format = 'BMP' then - begin - LoadBitmap( aSourceStream : TStream; TextureB ); - - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end + LoadBitmap( lTextureStream , TextureB ) else if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end + LoadJpeg( lTextureStream , TextureB ) else if Format = 'PNG' then begin {$IFNDEF FPC} -- cgit v1.2.3 From 7e01085a1981f28e538b06bff5cebf2b88c975af Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:20:20 +0000 Subject: fixed nasty bug I introduced... sorry.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@419 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 2 ++ Game/Code/Classes/UTexture.pas | 23 ++++++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index ee1a74f3..1e4a9f6a 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -79,6 +79,8 @@ procedure BuildFont; // Build Our Bitmap Font Rejestr: TResourceStream; begin {$IFNDEF FPC} + Log.LogStatus( 'TextGL - BUILDFONT - load Font Resource - ' + inttostr( integer( aID ) ) , aType +' '+ aResourceName ); + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); try Rejestr.Read(Fonts[ aID ].Width, 256); diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index e7038e78..96c0ec28 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -316,6 +316,8 @@ function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boo begin result := false; try + Log.LogStatus( ' TTextureUnit.LoadBitmap' , '' ); + aSourceStream.position := 0; aIMG.LoadFromStream( aSourceStream ); finally @@ -329,6 +331,8 @@ var begin result := false; try + Log.LogStatus( ' TTextureUnit.LoadJpeg' , ''); + aSourceStream.position := 0; TextureJ := TJPEGImage.Create; @@ -375,6 +379,7 @@ var lTextureStream : TStream; begin + lTextureStream := nil; Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); // {$IFNDEF FPC} @@ -390,9 +395,13 @@ begin if FromRegistry then begin try -// Res := TResourceStream.Create(HInstance, Identifier, Format); + + Log.LogStatus( ' A' , ''); + + // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - + Log.LogStatus( ' B' , ''); + // TODO : Where does the format come from except Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); @@ -406,13 +415,17 @@ begin begin // Get the File Extension... Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - lTextureStream := TFileStream.create( Identifier , fmOpenRead ); + lTextureStream := TFileStream.create( Identifier , fmOpenRead or fmShareDenyNone ); end; end; -// if FromRegistry or -// ((not FromRegistry) and FileExists(Identifier)) then + if assigned( lTextureStream ) then begin + Log.LogStatus( ' C - '+Format , ''); + + // TEmp, untill all code is moved to refactord way.. + Res := TResourceStream( lTextureStream ); + TextureB := TBitmap.Create; if Format = 'BMP' then -- cgit v1.2.3 From 333ec29a5275fb851f38f7be695930ea1dfe8340 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:28:04 +0000 Subject: remove logging git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@420 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 96c0ec28..389dd0b0 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -381,7 +381,8 @@ var begin lTextureStream := nil; - Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); +// Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); + // {$IFNDEF FPC} // TODO : JB_lazarus eeeew this is a nasty one... // but lazarus implementation scanlines is different :( @@ -395,14 +396,11 @@ begin if FromRegistry then begin try - - Log.LogStatus( ' A' , ''); - // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - Log.LogStatus( ' B' , ''); - // TODO : Where does the format come from + // TEmp, untill all code is moved to refactord way.. + Res := TResourceStream( lTextureStream ); except Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); beep; @@ -421,11 +419,6 @@ begin if assigned( lTextureStream ) then begin - Log.LogStatus( ' C - '+Format , ''); - - // TEmp, untill all code is moved to refactord way.. - Res := TResourceStream( lTextureStream ); - TextureB := TBitmap.Create; if Format = 'BMP' then -- cgit v1.2.3 From 707441e6eac0f628f9c61f0130df07c6768ba291 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:45:24 +0000 Subject: tidy texture loading. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@421 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 3 +-- Game/Code/Classes/UGraphic.pas | 9 +++++++-- Game/Code/Classes/UTexture.pas | 17 ++++++++++------- 3 files changed, 18 insertions(+), 11 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 1e4a9f6a..c228b40a 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -79,8 +79,7 @@ procedure BuildFont; // Build Our Bitmap Font Rejestr: TResourceStream; begin {$IFNDEF FPC} - Log.LogStatus( 'TextGL - BUILDFONT - load Font Resource - ' + inttostr( integer( aID ) ) , aType +' '+ aResourceName ); - + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); try Rejestr.Read(Fonts[ aID ].Width, 256); diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 7094c0f9..a8728fa7 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -383,8 +383,13 @@ begin // Show the Loading Screen ------------- LoadLoadingScreen; - - + Log.LogStatus('Loading Screens', 'Initialize3D'); + + +// LoadTextures; // jb +// Log.LogStatus(' Loading Textures', ''); + + // now that we have something to display while loading, // start thread that loads the rest of ultrastar diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 389dd0b0..f01cfd23 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -90,8 +90,8 @@ type TTextureUnit = class private - function LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; - function LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; + function LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; + function LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; public Limit: integer; CreateCacheMipmap: boolean; @@ -312,7 +312,7 @@ begin end; -function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; +function TTextureUnit.LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; begin result := false; try @@ -325,7 +325,7 @@ begin end; end; -function TTextureUnit.LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; +function TTextureUnit.LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; var TextureJ: TJPEGImage; begin @@ -396,7 +396,6 @@ begin if FromRegistry then begin try - // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); // TEmp, untill all code is moved to refactord way.. @@ -413,7 +412,9 @@ begin begin // Get the File Extension... Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - lTextureStream := TFileStream.create( Identifier , fmOpenRead or fmShareDenyNone ); + + lTextureStream := TMemoryStream.create(); + TMemoryStream(lTextureStream).loadfromfile( Identifier ); end; end; @@ -990,7 +991,9 @@ begin if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - end; // logerror + end; // logerror + +// freeandnil( lTextureStream ); // TODO - jb - free this.. but we cant at the moment :( // {$ENDIF} end; -- cgit v1.2.3 From fd5f18250e6da98c47f23f49b7c4663c9a8bf7d3 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 12:37:24 +0000 Subject: Adding new Resource compiler for lazarus projects.. (other one did not name resources correctly) this resource compiler could be expanded by someone to Parse Ultrastar.rc and compile the lrs file, rather than having it hardcoded in USDXResCompiler other changes, include ability to read the Resource String properly in code generated by lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@422 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 43 ++++++++++++++++++++++++++---------------- Game/Code/Classes/UTexture.pas | 22 +++++++++++++-------- 2 files changed, 41 insertions(+), 24 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index a8728fa7..3fbef8b1 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -245,6 +245,12 @@ uses UMain, {$ENDIF} Classes; +procedure LoadFontTextures; +begin + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + procedure LoadTextures; @@ -261,6 +267,8 @@ begin Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? // P1-6 + // TODO... do it once for each player... this is a bit crappy !! + // can we make it any better !? for P := 1 to 6 do begin LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); @@ -307,8 +315,8 @@ begin //PhrasenBonus - Line Bonus Mod End // tworzenie czcionek - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; +// Log.LogStatus('Building Fonts', 'LoadTextures'); +// BuildFont; end; procedure Initialize3D (Title: string); @@ -320,12 +328,13 @@ var I: Integer; begin Log.LogStatus('LoadOpenGL', 'Initialize3D'); - Log.BenchmarkStart(2); +// Log.BenchmarkStart(2); LoadOpenGL; Log.LogStatus('SDL_Init', 'Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then + begin Log.LogError('SDL_Init Failed', 'Initialize3D'); exit; end; @@ -355,17 +364,17 @@ begin InitializeScreen; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Setting Screen', 2); +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Setting Screen', 2); // ladowanie tekstur - Log.BenchmarkStart(2); +// Log.BenchmarkStart(2); Texture := TTextureUnit.Create; Texture.Limit := 1024*1024; - LoadTextures; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Textures', 2); +// LoadTextures; +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Loading Textures', 2); { Log.BenchmarkStart(2); Lyric:= TLyric.Create; @@ -373,21 +382,23 @@ begin Log.LogBenchmark('--> Loading Fonts', 2); } - Log.BenchmarkStart(2); +// Log.BenchmarkStart(2); Display := TDisplay.Create; SDL_EnableUnicode(1); - Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); +// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - Log.LogStatus('Loading Screens', 'Initialize3D'); - Log.BenchmarkStart(3); +// Log.LogStatus('Loading Screens', 'Initialize3D'); +// Log.BenchmarkStart(3); + + LoadFontTextures(); // Show the Loading Screen ------------- LoadLoadingScreen; Log.LogStatus('Loading Screens', 'Initialize3D'); -// LoadTextures; // jb -// Log.LogStatus(' Loading Textures', ''); + LoadTextures; // jb + Log.LogStatus(' Loading Textures', ''); diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f01cfd23..1c436f04 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -154,32 +154,36 @@ begin // find texture entry T := FindTexture(Name); - if T = -1 then begin + if T = -1 then + begin // create texture entry T := Length(TextureDatabase.Texture); SetLength(TextureDatabase.Texture, T+1); + TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; + TextureDatabase.Texture[T].Typ := Typ; // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].Texture.TexNum := -1; TextureDatabase.Texture[T].TextureCache.TexNum := -1; end; // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then begin + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin // load texture TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); end; // use texture Result := TextureDatabase.Texture[T].Texture; - end; - if FromCache and Covers.CoverExists(Name) then begin + if FromCache and Covers.CoverExists(Name) then + begin // use cache texture C := Covers.CoverNumber(Name); @@ -381,7 +385,7 @@ var begin lTextureStream := nil; -// Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); + Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); // {$IFNDEF FPC} // TODO : JB_lazarus eeeew this is a nasty one... @@ -396,10 +400,12 @@ begin if FromRegistry then begin try + {$IFNDEF FPC} lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); // TEmp, untill all code is moved to refactord way.. Res := TResourceStream( lTextureStream ); + {$ENDIF} except Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); beep; -- cgit v1.2.3 From bc436ae00c8098f2e77f20bfe2ab185ecfe7a8e0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 12:46:13 +0000 Subject: now we have a better laz-resource compiler.. we use the correct resource names and types.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@423 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index c228b40a..14f81a9b 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -78,15 +78,12 @@ procedure BuildFont; // Build Our Bitmap Font var Rejestr: TResourceStream; begin - {$IFNDEF FPC} - Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); try Rejestr.Read(Fonts[ aID ].Width, 256); finally Rejestr.Free; end; - {$ENDIF} end; var @@ -129,20 +126,10 @@ begin - {$IFDEF FPC} - loadfont( 0, 'DAT', 'eurostar_regular' ); - loadfont( 1, 'DAT', 'eurostar_regular_bold' ); - loadfont( 2, 'DAT', 'Outline 1' ); - loadfont( 3, 'DAT', 'Outline 2' ); - {$ELSE} - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - {$ENDIF} - - - + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); { Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); Rejestr.Read(Fonts[4].Width, 256); -- cgit v1.2.3 From f26a2364e41b95665d9e55593eb0c0e8f4cf646b Mon Sep 17 00:00:00 2001 From: mogguh Date: Fri, 21 Sep 2007 11:20:41 +0000 Subject: ScoreScreen, still working on some minor things like simplifying the src (messy joes), color stuff, overlay for the bars, 2 screen fix and when the bars should be drawn (regarding to the playercount) - other skin stuff will follow soon git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@426 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 4c8a4076..290db271 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -6,8 +6,8 @@ #############################################################################} //{$define DebugDisplay} // uncomment if u want to see the debug stuff -{$define DebugFrames} -{$define Info} +//{$define DebugFrames} +//{$define Info} unit UVideo; -- cgit v1.2.3 From c2400c9068e053375bd496ab8f2092a4840bc3ca Mon Sep 17 00:00:00 2001 From: mogguh Date: Fri, 21 Sep 2007 15:13:54 +0000 Subject: Feature: window title bar icon / taskman icon pre-work, needs fixing after we can read from res w/ sdl_img git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@427 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 3fbef8b1..3f251be2 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -506,6 +506,11 @@ begin Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); + +// Okay it's possible to set the title bar / taskbar icon here +// it's working this way, but just if the bmp is in your exe folder + SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); + // SDL_SetRefreshrate(85); // SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); if (Ini.FullScreen = 0) and (Not Params.FullScreen) then -- cgit v1.2.3 From 217cd16e10ff809e7382e5447f1ccde60f3e8564 Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 21 Sep 2007 22:15:36 +0000 Subject: first try to load textures with SDL_Image supported texture types are: Plain, Transparent and Colorized (textures in the resource file must be typed TEX) everything else (Font Black, ...) is not implemented. So beware - it looks really broken. There seems to be a problem with The covers - I just didn't understand, what's going on there. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@428 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 942 +++++++++++++++++------------------------ 1 file changed, 381 insertions(+), 561 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 1c436f04..78a2573f 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -2,6 +2,9 @@ unit UTexture; // Plain (alpha = 1) // Transparent +// Colorized + +// obsolete? // Transparent Range // Font (white is drawn, black is transparent) // Font Outline (Font with darker outline) @@ -25,15 +28,12 @@ uses OpenGL12, Math, Classes, SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - JPEG, - PNGImage, - {$ENDIF} Graphics, UCommon, - UThemes; + UThemes, + SDL, + sdlutils, + SDL_Image; {$IFDEF Win32} @@ -45,7 +45,7 @@ uses OpenGL12, {$ELSE} const opengl32 = 'libGL.so' ; // YES Capital GL {$ENDIF} - + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; {$ENDIF} @@ -88,10 +88,16 @@ type end; TTextureUnit = class - + private - function LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; - function LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + public Limit: integer; CreateCacheMipmap: boolean; @@ -108,27 +114,19 @@ type end; var - lasthue: double; Texture: TTextureUnit; TextureDatabase: TTextureDatabase; + // this should be in UDisplay?! PrintScreenData: array[0..1024*768-1] of longword; ActTex: GLuint;//integer; - TexOrigW: integer; - TexOrigH: integer; - TexNewW: integer; - TexNewH: integer; - - TexFitW: integer; - TexFitH: integer; // new for limit - - TextureD8: array[1..1024*1024] of byte; // 1MB +// TextureD8: array[1..1024*1024] of byte; // 1MB TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) - TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) - TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) - TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) // total 40MB at 2048*2048 // total 10MB at 1024*1024 @@ -140,141 +138,244 @@ var implementation uses ULog, DateUtils, UCovers, StrUtils; -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); +const + fmt_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); + fmt_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); + + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; end; -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - // find texture entry - T := FindTexture(Name); - - if T = -1 then +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; + var + stream : TStream; + origin : Word; begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; + 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; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; + var + stream : TStream; begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + 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; - - // use texture - Result := TextureDatabase.Texture[T].Texture; end; - - if FromCache and Covers.CoverExists(Name) then + function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; + var + stream : TStream; begin - // use cache texture - C := Covers.CoverNumber(Name); + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; + end; +// ----------------------------------------------- - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + TexStream: TStream; + TexRWops: PSDL_RWops; + dHandle: THandle; + +begin + Result:=nil; + TexRWops:=nil; + Log.LogStatus( ' start' , Identifier); + if ( FileExists(Identifier) ) then + begin + Log.LogStatus( ' found file' , ' '+ Identifier); + // load from file + Result:=IMG_Load(Identifier); + end + else + begin + Log.LogStatus( ' trying resource' , ' '+ Identifier); + // load from resource stream + dHandle:=FindResource(hInstance,Identifier,'TEX'); + if dHandle=0 then begin + Log.LogStatus( 'ERROR Could not find resource' , Identifier); + beep; + Exit; end; + + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + TexRWops:=SDL_AllocRW; + TexRWops.unknown:=TUnknown(TexStream); + TexRWops.seek:=SDLStreamSeek; + TexRWops.read:=SDLStreamRead; + TexRWops.write:=nil; + TexRWops.close:=SDLStreamClose; + TexRWops.type_:=2; + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + TexStream.Free; + end; + Log.LogStatus( ' DONE' , '---'+ Identifier); +end; - // use texture - Result := TextureDatabase.Texture[T].TextureCache; +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb; + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba; + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); end; end; -function TTextureUnit.FindTexture(Name: string): integer; +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; var - T: integer; // texture + TempSurface: PSDL_Surface; begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); end; -// expects: src, dst: pointers to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; + TempSurface: PSDL_Surface; begin - hls[0]:=hue; + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; - clr[0] := src[0]/255; - clr[1] := src[1]/255; - clr[2] := src[2]/255; - //calculate luminance and saturation from rgb hls[1] := maxvalue(clr); //l:=... delta := hls[1] - minvalue(clr); - + if hls[1] = 0.0 then hls[2] := 0.0 else hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=src[3]; - end; -end; -// expects: src: $rrggbb -// dst: pointer to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0]:=((src shr 16) and $ff)/255; - clr[1]:=((src shr 8) and $ff)/255; - clr[2]:=(src and $ff)/255; - //calculate luminance and saturation from rgb - hls[1]:=maxvalue(clr); //l:=... - delta:=hls[1]-minvalue(clr); - if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense begin k:=trunc(hls[0]); f:=hls[0]-k; @@ -290,428 +391,135 @@ begin 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; end; // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=255; + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); end; -end; -//returns hue within range [0.0-6.0) -function col2h(Color:Cardinal):double; -var - clr,hls: array[0..2] of double; - delta: double; -begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; -end; - - -function TTextureUnit.LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; -begin - result := false; - try - Log.LogStatus( ' TTextureUnit.LoadBitmap' , '' ); - - aSourceStream.position := 0; - aIMG.LoadFromStream( aSourceStream ); - finally - result := aSourceStream.position > 0; end; -end; -function TTextureUnit.LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; var - TextureJ: TJPEGImage; + DestinationHue: Double; + PixelIndex: Cardinal; begin - result := false; - try - Log.LogStatus( ' TTextureUnit.LoadJpeg' , ''); - - aSourceStream.position := 0; - - TextureJ := TJPEGImage.Create; - try - TextureJ.LoadFromStream( aSourceStream ); - aIMG.Assign(TextureJ); - finally - TextureJ.Free; - end; - finally - result := aSourceStream.position > 0; - end; + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); end; - - - function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var - Res: TResourceStream; - TextureB: TBitmap; - TextureJ: TJPEGImage; - {$IFNDEF FPC} - TexturePNG: TPNGObject; - {$ENDIF} - - TextureAlpha: array of byte; - AlphaPtr: PByte; - TransparentColor: TColor; - PixelColor: TColor; + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; - SkipX: integer; - myAlpha: Real; - myRGBABitmap: array of byte; - RGBPtr: PByte; - myHue: Double; - - lTextureStream : TStream; begin - lTextureStream := nil; - - Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); - -// {$IFNDEF FPC} - // TODO : JB_lazarus eeeew this is a nasty one... - // but lazarus implementation scanlines is different :( - // need to implement as per - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 - // http://wiki.lazarus.freepascal.org/Developing_with_Graphics Log.BenchmarkStart(4); Mipmapping := true; - if FromRegistry then - begin - try - {$IFNDEF FPC} - lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - - // TEmp, untill all code is moved to refactord way.. - Res := TResourceStream( lTextureStream ); - {$ENDIF} - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - end + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') else - begin - if ( FileExists(Identifier) ) then - begin - // Get the File Extension... - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); - lTextureStream := TMemoryStream.create(); - TMemoryStream(lTextureStream).loadfromfile( Identifier ); - end; - end; - - if assigned( lTextureStream ) then + // load texture data into memory + TexSurface:=LoadImage(Identifier); + if not assigned(TexSurface) then begin - TextureB := TBitmap.Create; + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; - if Format = 'BMP' then - LoadBitmap( lTextureStream , TextureB ) - else - if Format = 'JPG' then - LoadJpeg( lTextureStream , TextureB ) - else if Format = 'PNG' then + // convert pixel format as needed + AdjustPixelFormat(TexSurface, Typ); + + // adjust texture size (scale down, if necessary) + newWidth:=TexSurface^.W; + newHeight:=TexSurface.H; + if (newWidth > Limit) then + newWidth:=Limit; + if (newHeight > Limit) then + newHeight:=Limit; + if (TexSurface.W > newWidth) or (TexSurface^.H > newHeight) then + ScaleTexture(TexSurface,newWidth,newHeight); + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then begin - {$IFNDEF FPC} - // TODO : JB_lazarus - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else + if (Covers.W <= 256) and (Covers.H <= 256) then begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + System.Move(MipmapSurface^.pixels,CacheMipmap,Covers.W*Covers.H*3-1); + SDL_FreeSurface(MipmapSurface); end; - - TextureB.Assign(TexturePNG); - // transparent png hack start (part 1 of 2) - if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then - begin - setlength(TextureAlpha, TextureB.Width*TextureB.Height); - setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); - if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or - (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then - begin - // i would have preferred english variables here but i use Position because i'm lazy - for Position := 0 to TextureB.Height - 1 do - begin - AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); - RGBPtr:=PByte(TexturePNG.Scanline[Position]); - for Position2 := 0 to TextureB.Width - 1 do - begin - TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; - MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; -// Inc(RGBPtr); - Inc(AlphaPtr); - end; - end; - end; - end else - setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) - // transparent png hack end - TexturePNG.Free; - {$ENDIF} + // should i create a cache texture, if Covers.W/H are larger? end; - if FromRegistry then Res.Free; - if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver - Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); - Result.TexNum := -1; - end else begin + // now we might colorize the whole thing + if Typ='Colorized' then ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture glGenTextures(1, ActTex); glBindTexture(GL_TEXTURE_2D, ActTex); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + // load data into gl texture if Typ = 'Plain' then begin - {$IFNDEF FPC} - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - - // copy and process pixeldata - TextureB.PixelFormat := pf24bit; -{ if (TextureB.PixelFormat = pf8bit) then begin - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD24[Position*TexNewW + Position2+1, 1] := Pix; - TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - end; - end; - end;} - if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - end else begin - // limit - TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrigH; - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, - Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time - - TexNewW := Limit; - TexNewH := Limit; - TexOrigW := Limit; - TexOrigH := Limit; - end; - - // creating cache mipmap - if CreateCacheMipmap then begin - if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin - // texture only uses some of it's space. there's a need for resize to fit full size - // and get best quality - TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrigH; - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; - TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; - TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - - end else begin - // texture fits perfectly - gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - end; - end; - - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Error > 0 then beep; - end - {$ENDIF} + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface^.pixels); end; - if Typ = 'Transparent' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - // ,- part of transparent png hack - if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) - TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; - end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; - TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; - end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); - TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); - TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); - TextureD32[Position*TexNewW + Position2+1, 4] := 255; - end; - end; - end; - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} + if (Typ = 'Transparent') or (Typ='Colorized') then begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface^.pixels); end; - -// The new awesomeness of colorized pngs starts here -// We're the first who had this feature, so give credit when you copy+paste :P - if Typ = 'Colorized' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - myHue:=col2h(Col); - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then - ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue) - else - ColorizeCopy(Pix, - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue); - end; - end; - - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -// eoa COLORIZE - - if Typ = 'Transparent Range' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) Pix := TextureB.Canvas.Pixels[Position2, Position]; TextureD32[Position*TexNewW + Position2+1, 1] := Pix; TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - +} +{ if Typ = 'Font' then - begin - {$IFNDEF FPC} - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) Pix := PPix[Position2 * 3]; TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - end; - end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - {$ENDIF} - end; - +} +{ if Typ = 'Font Outline' then + // no idea... begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -732,18 +540,12 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - {$ENDIF} end; - +} +{ if Typ = 'Font Outline 2' then + // same as above begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -762,18 +564,16 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); if Error > 0 then beep; end; - {$ENDIF} end; if Typ = 'Font Black' then + // and so on begin - {$IFNDEF FPC} // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? // dimensions TextureB.PixelFormat := pf24bit; @@ -795,12 +595,11 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; TexOrigW := TextureB.Width; TexOrigH := TextureB.Height; @@ -820,12 +619,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; if Typ = 'Font Gray' then begin - {$IFNDEF FPC} // dimensions TexOrigW := TextureB.Width; TexOrigH := TextureB.Height; @@ -844,16 +641,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - {$ENDIF} end; if Typ = 'Arrow' then begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -882,12 +673,10 @@ begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); if Error > 0 then beep; end; - {$ENDIF} end; if Typ = 'Note Plain' then begin - {$IFNDEF FPC} for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -921,12 +710,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - {$ENDIF} end; if Typ = 'Note Transparent' then begin - {$IFNDEF FPC} for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; for Position2 := 0 to TextureB.Width-1 do begin @@ -961,10 +748,9 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; +} - TextureB.Free; Result.X := 0; Result.Y := 0; Result.W := 0; @@ -973,8 +759,8 @@ begin Result.ScaleH := 1; Result.Rot := 0; Result.TexNum := ActTex; - Result.TexW := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; Result.Int := 1; Result.ColR := 1; @@ -991,52 +777,86 @@ begin // 0.5.0 Result.Name := Identifier; - end; + SDL_FreeSurface(TexSurface); + Log.BenchmarkEnd(4); if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); +end; - end; // logerror -// freeandnil( lTextureStream ); // TODO - jb - free this.. but we cant at the moment :( -// {$ENDIF} +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); end; -{procedure ResizeTexture(s: pbytearray; d: pbytearray); +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; var - Position: integer; - Position2: integer; + T: integer; // texture + C: integer; // cover + Data: array of byte; begin - for Position := 0 to TexNewH*4-1 do - for Position2 := 0 to TexNewW-1 do - d[Position*TexNewW + Position2] := 0; - - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; - d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; - d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; - d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; end; -end;} +end; -{procedure SetTexture(p: pointer); +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture begin - glGenTextures(1, Tekstur); - glBindTexture(GL_TEXTURE_2D, Tekstur); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); -end;} + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; begin Result := LoadTexture(false, Identifier, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg - end; function TTextureUnit.LoadTexture(Identifier: string): TTexture; -- cgit v1.2.3 From cf1102dac69a569279ae05dd95426d9e1c544ffc Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 22 Sep 2007 08:15:59 +0000 Subject: minor bug fixes to have lazarus build load resources into SDL_Image correctly... ( lazarus Resources are weak compared to delphi :( ) also Laz build will now run, and main loop works properly. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@429 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 780 +++++++++++++++++++++-------------------- Game/Code/Classes/UCommon.pas | 26 +- Game/Code/Classes/UGraphic.pas | 26 +- Game/Code/Classes/USkins.pas | 335 +++++++++--------- Game/Code/Classes/UTexture.pas | 250 ++++++++----- 5 files changed, 792 insertions(+), 625 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 14f81a9b..e8d5e878 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,376 +1,404 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses OpenGL12, - SDL, - UTexture, - Classes, - 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); - -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; - 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; - -implementation - -uses UMain, - {$IFDEF win32} - windows, - {$ELSE} - lclintf, - lcltype, - {$ENDIF} - SysUtils, - {$IFDEF FPC} - LResources, - {$ENDIF} - UGraphic; - -procedure BuildFont; // Build Our Bitmap Font - - procedure loadfont( aID : integer; aType, aResourceName : String); - var - Rejestr: TResourceStream; - begin - Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); - try - Rejestr.Read(Fonts[ aID ].Width, 256); - finally - Rejestr.Free; - end; - end; - -var - font: HFONT; // Windows Font ID - h_dc: hdc; - Pet: integer; -begin - ActFont := 0; - - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); - Fonts[0].Tex.H := 30; - Fonts[0].AspectW := 0.9; - Fonts[0].Done := -1; - Fonts[0].Outline := 0; - - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Done := -1; - Fonts[1].Outline := 0; - - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Font Outline', 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Done := -1; - Fonts[2].Outline := 5; - - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - - - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - -{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Rejestr.Read(Fonts[4].Width, 256); - Rejestr.Free;} - - for Pet := 0 to 255 do - Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; - - for Pet := 0 to 255 do - Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; - - for Pet := 0 to 255 do - Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; - -{ for Pet := 0 to 255 do - Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} - -end; - -procedure KillFont; // Delete The Font -begin -// glDeleteLists(base, 256); // Delete All 96 Characters -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; -begin -// Log.LogStatus(Text, 'glTextWidth'); - Result := 0; - while (length(text) > 0) do begin - Letter := Text[0]; - text := pchar(Copy(text, 2, Length(text)-1)); - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; // while -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; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter -begin - with Fonts[ActFont].Tex do begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; -// H := 30; - - // 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; - - // 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); - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); - glEnd; - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with -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; - -procedure glPrint(text: pchar); // Custom GL "Print" Routine -var - Letter: char; -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 -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; - -{$IFDEF FPC} -{$IFDEF win32} -initialization - {$I UltraStar.lrs} -{$ENDIF} -{$ENDIF} - -end. - - +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses OpenGL12, + SDL, + UTexture, + Classes, + 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); + +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; + 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; + +implementation + +uses UMain, + UCommon, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + lcltype, + {$ENDIF} + SysUtils, + {$IFDEF FPC} + LResources, + {$ENDIF} + UGraphic; + +procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont( aID : integer; aType, aResourceName : String); + {$IFDEF FPC} + var + lLazRes : TLResource; + lResData : TStringStream; + begin + try + lLazRes := LazFindResource( aResourceName, aType ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + lResData.Read(Fonts[ aID ].Width, 256); + finally + freeandnil( lResData ); + end; + end; + + {$ELSE} + var + Rejestr: TResourceStream; + begin + try + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); + try + Rejestr.Read(Fonts[ aID ].Width, 256); + finally + Rejestr.Free; + end; + {$ENDIF} + + except + Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); + end; + end; + +var + font: HFONT; // Windows Font ID + h_dc: hdc; + Pet: integer; +begin + ActFont := 0; + + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Done := -1; + Fonts[0].Outline := 0; + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Done := -1; + Fonts[1].Outline := 0; + + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Font Outline', 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Done := -1; + Fonts[2].Outline := 5; + + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); + +{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[4].Width, 256); + Rejestr.Free;} + + for Pet := 0 to 255 do + Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; + + for Pet := 0 to 255 do + Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; + + for Pet := 0 to 255 do + Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; + +{ for Pet := 0 to 255 do + Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + while (length(text) > 0) do begin + Letter := Text[0]; + text := pchar(Copy(text, 2, Length(text)-1)); + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; // while +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; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; +// H := 30; + + // 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; + + // 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); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + glEnd; + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +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; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +var + Letter: char; +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 +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; + + +{$IFDEF FPC} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + + +end. + + diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b572a768..8089f28c 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -7,7 +7,10 @@ interface {$ENDIF} uses - +{$IFDEF FPC} + lResources, +{$ENDIF} + ULog, {$IFDEF win32} windows; {$ELSE} @@ -28,7 +31,9 @@ type type TWndMethod = procedure(var Message: TMessage) of object; -function RandomRange(aMin: Integer; aMax: Integer) : Integer; +function LazFindResource( const aName, aType : String ): TLResource; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; function MaxValue(const Data: array of Double): Double; function MinValue(const Data: array of Double): Double; @@ -82,6 +87,23 @@ end; {$IFDEF FPC} +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; + function MaxValue(const Data: array of Double): Double; var I: Integer; diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 3f251be2..f350d0d2 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -266,6 +266,8 @@ begin Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + Log.LogStatus('Loading Textures - A', 'LoadTextures'); + // P1-6 // TODO... do it once for each player... this is a bit crappy !! // can we make it any better !? @@ -287,6 +289,8 @@ begin Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); end; + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); @@ -303,17 +307,27 @@ begin Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); //end Singbar Mod + Log.LogStatus('Loading Textures - C', 'LoadTextures'); + + {$IFNDEF FPC} + // TODO : jb_FPC why does this cause lazarus build, to have runtime error.. + // TODO : jb_FPC - START HERE !! //Line Bonus PopUp for P := 0 to 8 do begin Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); end; + {$ENDIF} + + {//Set Texture to Font High Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } //PhrasenBonus - Line Bonus Mod End + Log.LogStatus('Loading Textures - D', 'LoadTextures'); + // tworzenie czcionek // Log.LogStatus('Building Fonts', 'LoadTextures'); // BuildFont; @@ -327,15 +341,15 @@ var Pixel: PByteArray; I: Integer; begin - Log.LogStatus('LoadOpenGL', 'Initialize3D'); + Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); // Log.BenchmarkStart(2); LoadOpenGL; - Log.LogStatus('SDL_Init', 'Initialize3D'); + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then begin - Log.LogError('SDL_Init Failed', 'Initialize3D'); + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); exit; end; @@ -390,15 +404,16 @@ begin // Log.LogStatus('Loading Screens', 'Initialize3D'); // Log.BenchmarkStart(3); + Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); LoadFontTextures(); // Show the Loading Screen ------------- + Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); LoadLoadingScreen; - Log.LogStatus('Loading Screens', 'Initialize3D'); + Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); LoadTextures; // jb - Log.LogStatus(' Loading Textures', ''); @@ -412,6 +427,7 @@ begin //LoadingThread := SDL_CreateThread(@LoadingThread, nil); // das hier würde dann im ladethread ausgeführt + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); LoadScreens; diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index a825050f..7fdbacde 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -1,164 +1,171 @@ -unit USkins; - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -interface - -type - TSkinTexture = record - Name: string; - FileName: string; - end; - - TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet - end; - - TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; - constructor Create; - procedure LoadList; - procedure ParseDir(Dir: string); - procedure LoadHeader(FileName: string); - procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): string; - function GetSkinNumber(Name: string): integer; - procedure onThemeChange; - end; - -var - Skin: TSkin; - -implementation - -uses IniFiles, Classes, SysUtils, ULog, UIni; - -constructor TSkin.Create; -begin - LoadList; -// LoadSkin('Lisek'); -// SkinColor := Color; -end; - -procedure TSkin.LoadList; -var - SR: TSearchRec; -// SR2: TSearchRec; -// SLen: integer; -begin - if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir('Skins'+PathDelim + SR.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); -end; - -procedure TSkin.ParseDir(Dir: string); -var - SR: TSearchRec; -// SLen: integer; -begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - LoadHeader(Dir + SR.Name); - //Log.LogError(SR.Name); - until FindNext(SR) <> 0; - end; -end; - -procedure TSkin.LoadHeader(FileName: string); -var - SkinIni: TMemIniFile; - S: integer; -begin - SkinIni := TMemIniFile.Create(FileName); - - S := Length(Skin); - SetLength(Skin, S+1); - Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); - Skin[S].FileName := ExtractFileName(FileName); - Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); - Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); - Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); - - SkinIni.Free; -end; - -procedure TSkin.LoadSkin(Name: string); -var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; -begin - S := GetSkinNumber(Name); - SkinPath := Skin[S].Path; - - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); - - SL := TStringList.Create; - SkinIni.ReadSection('Textures', SL); - - SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do begin - SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); - end; - - SL.Free; - SkinIni.Free; -end; - -function TSkin.GetTextureFileName(TextureName: string): string; -var - T: integer; -begin - Result := ''; - for T := 0 to High(SkinTexture) do - if SkinTexture[T].Name = TextureName then Result := SkinPath + SkinTexture[T].FileName; - -{ Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} -end; - -function TSkin.GetSkinNumber(Name: string): integer; -var - S: integer; -begin - Result := 0; // set default to the first available skin - for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; -end; - -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; -begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; - end; - -end; - -end. +unit USkins; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +interface + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, Classes, SysUtils, ULog, UIni; + +constructor TSkin.Create; +begin + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; +// SR2: TSearchRec; +// SLen: integer; +begin + if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir('Skins'+PathDelim + SR.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; +// SLen: integer; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + //Log.LogError(SR.Name); + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + + for T := 0 to High(SkinTexture) do + begin + if ( SkinTexture[T].Name = TextureName ) AND + ( SkinTexture[T].FileName <> '' ) then + begin + Result := SkinPath + SkinTexture[T].FileName; + end; + end; + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + Ini.SkinNo:=0; + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 78a2573f..3d746813 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -136,58 +136,65 @@ var implementation -uses ULog, DateUtils, UCovers, StrUtils; + +uses ULog, + DateUtils, + UCovers, + {$IFDEF FPC} + LResources, + {$ENDIF} + StrUtils; const fmt_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); - fmt_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); + 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); + fmt_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); function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; end; // +++++++++++++++++++++ helpers for loadimage +++++++++++++++ @@ -235,50 +242,119 @@ end; function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; var - TexStream: TStream; + TexRWops: PSDL_RWops; dHandle: THandle; + {$IFDEF FPC} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + begin - Result:=nil; - TexRWops:=nil; - Log.LogStatus( ' start' , Identifier); + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + if ( FileExists(Identifier) ) then begin - Log.LogStatus( ' found file' , ' '+ Identifier); // load from file - Result:=IMG_Load(Identifier); - end - else - begin - Log.LogStatus( ' trying resource' , ' '+ Identifier); - // load from resource stream - dHandle:=FindResource(hInstance,Identifier,'TEX'); - if dHandle=0 then begin - Log.LogStatus( 'ERROR Could not find resource' , Identifier); - beep; - Exit; - end; - +// Log.LogStatus( 'Is File', ' LoadImage' ); try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - TexRWops:=SDL_AllocRW; - TexRWops.unknown:=TUnknown(TexStream); - TexRWops.seek:=SDLStreamSeek; - TexRWops.read:=SDLStreamRead; - TexRWops.write:=nil; - TexRWops.close:=SDLStreamClose; - TexRWops.type_:=2; + Result:=IMG_Load(Identifier); except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + Log.LogStatus( 'ERROR Could not load from file' , Identifier); beep; Exit; end; - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - TexStream.Free; + end + else + begin +// Log.LogStatus( 'NOT File', ' LoadImage' ); + + // load from resource stream + {$IFNDEF FPC} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource', ' LoadImage' ); + end; + {$ENDIF} + + end; - Log.LogStatus( ' DONE' , '---'+ Identifier); end; procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); @@ -417,13 +493,19 @@ begin Log.BenchmarkStart(4); Mipmapping := true; + + +(* + Log.LogStatus( '', '' ); + if Identifier = nil then Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') else Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) // load texture data into memory - TexSurface:=LoadImage(Identifier); + TexSurface := LoadImage(Identifier); if not assigned(TexSurface) then begin Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); @@ -797,6 +879,10 @@ var C: integer; // cover Data: array of byte; begin + + if Name = '' then + exit; + // find texture entry T := FindTexture(Name); @@ -939,4 +1025,12 @@ begin end; end; +{$IFDEF FPC} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + + end. -- cgit v1.2.3 From 1f9fd791bbe68741b8273a64eb5c0abe928e431c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 23 Sep 2007 14:00:46 +0000 Subject: New class for score management -Scores are raised when PopUp slides under the scorebg -1 to 6 Player support (even 5 Players(not supported by Core atm)) -Display 3 Players instead of 2 when 4 Players are set in the Options and Screens=2 Ratingbar is not drawn by class atm. Have to be done git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@430 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 8 +- Game/Code/Classes/UGraphic.pas | 53 ++- Game/Code/Classes/USingNotes.pas | 10 + Game/Code/Classes/USingScores.pas | 759 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 814 insertions(+), 16 deletions(-) create mode 100644 Game/Code/Classes/USingNotes.pas create mode 100644 Game/Code/Classes/USingScores.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 4c5d2ce0..5a175289 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -713,7 +713,7 @@ begin end; //end Singbar Mod - //PhrasenBonus - Line Bonus Mod + {//PhrasenBonus - Line Bonus Mod if Ini.LineBonus > 0 then begin A := GetTickCount div 33; if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin @@ -784,7 +784,7 @@ begin end; end; end; - //PhrasenBonus - Line Bonus Mod End + //PhrasenBonus - Line Bonus Mod End } // Set the note heights according to the difficulty level case Ini.Difficulty of @@ -1127,7 +1127,7 @@ begin end; //end Singbar Mod - //PhrasenBonus - Line Bonus Mod + {//PhrasenBonus - Line Bonus Mod if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin A := GetTickCount div 33; if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin @@ -1214,7 +1214,7 @@ begin end; end; end; -//PhrasenBonus - Line Bonus Mod End +//PhrasenBonus - Line Bonus Mod End } // resize the notes according to the difficulty level case Ini.Difficulty of diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index f350d0d2..6ea89c0f 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -156,6 +156,9 @@ var Tex_SingLineBonusBack: array[0..8] of TTexture; //End PhrasenBonus - Line Bonus Mod + //ScoreBG Texs + Tex_ScoreBG: array [0..5] of TTexture; + const Skin_BGColorR = 1; Skin_BGColorG = 1; @@ -315,22 +318,48 @@ begin //Line Bonus PopUp for P := 0 to 8 do begin - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', $FFFFFF); + Case P of + 0: begin + R := 1; + G := 0; + B := 0; + end; + 1..3: begin + R := 1; + G := (P * 0.25); + B := 0; + end; + 4: begin + R := 1; + G := 1; + B := 0; + end; + 5..7: begin + R := 1-((P-4)*0.25); + G := 1; + B := 0; + end; + 8: begin + R := 0; + G := 1; + B := 0; + end; + End; + + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); end; + + //Score BG Textures + for P := 0 to 5 do begin + LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); + end; + {$ENDIF} - - - {//Set Texture to Font High - Tex_SingLineBonusL.H := 32; Tex_SingLineBonusL.W := 8; - Tex_SingLineBonusM.H := 32; //Tex_SingLineBonusM.TexW := Tex_SingLineBonusM.TexW/2; - Tex_SingLineBonusR.H := 32; Tex_SingLineBonusR.W := 8; } - //PhrasenBonus - Line Bonus Mod End Log.LogStatus('Loading Textures - D', 'LoadTextures'); - - // tworzenie czcionek -// Log.LogStatus('Building Fonts', 'LoadTextures'); -// BuildFont; end; procedure Initialize3D (Title: string); diff --git a/Game/Code/Classes/USingNotes.pas b/Game/Code/Classes/USingNotes.pas new file mode 100644 index 00000000..e2162bf1 --- /dev/null +++ b/Game/Code/Classes/USingNotes.pas @@ -0,0 +1,10 @@ +unit USingNotes; + +interface +{ Dummy Unit atm + For further expantation + Placeholder for Class that will handle the Notes Drawing} + +implementation + +end. diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas new file mode 100644 index 00000000..27a65b32 --- /dev/null +++ b/Game/Code/Classes/USingScores.pas @@ -0,0 +1,759 @@ +unit USingScores; + +interface +uses UThemes, OpenGl12, UTexture; + +//Some Constances containing Options that could change by time +const + MaxPlayers = 6; //Maximum of Players that could be added + MaxPositions = 6; //Maximum of Score Positions that could be added + +type + //----------- + // TScorePlayer - Record Containing Information about a Players Score + //----------- + TScorePlayer = record + Position: Byte; //Index of the Position where the Player should be Drawn + Enabled: Boolean; //Is the Score Display Enabled + Visible: Boolean; //Is the Score Display Visible + Score: Word; //Current Score of the Player + ScoreDisplayed: Word; //Score cur. Displayed(for counting up) + ScoreBG: TTexture;//Texture of the Players Scores BG + Color: TRGB; //Teh Players Color + end; + aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; + + //----------- + // TScorePosition - Record Containing Information about a Score Position, that can be used + //----------- + PScorePosition = ^TScorePosition; + TScorePosition = record + //The Position is Used for Which Playercount + PlayerCount: Byte; + // 1 - One Player per Screen + // 2 - 2 Players per Screen + // 4 - 3 Players per Screen + // 6 would be 2 and 3 Players per Screen + + BGX: Real; //X Position of the Score BG + BGY: Real; //Y Position of the Score BG + BGW: Real; //Width of the Score BG + BGH: Real; //Height of the Score BG + + RBX: Real; //X Position of the Rating Bar + RBY: Real; //Y Position of the Rating Bar + RBW: Real; //Width of the Rating Bar + RBH: Real; //Height of the Rating Bar + + TextX: Real; //X Position of the Score Text + TextY: Real; //Y Position of the Score Text + TextFont: Byte; //Font of the Score Text + TextSize: Byte; //Size of the Score Text + + PUW: Real; //Width of the LineBonus Popup + PUH: Real; //Height of the LineBonus Popup + PUFont: Byte; //Font for the PopUps + PUFontSize: Byte; //FontSize for the PopUps + PUStartX: Real; //X Start Position of the LineBonus Popup + PUStartY: Real; //Y Start Position of the LineBonus Popup + PUTargetX: Real; //X Target Position of the LineBonus Popup + PUTargetY: Real; //Y Target Position of the LineBonus Popup + end; + aScorePosition = array[0..MaxPositions-1] of TScorePosition; + + //----------- + // TScorePopUp - Record Containing Information about a LineBonus Popup + // List, Next Item is Saved in Next attribute + //----------- + PScorePopUp = ^TScorePopUp; + TScorePopUp = record + Player: Byte; //Index of the PopUps Player + TimeStamp: Cardinal; //Timestamp of Popups Spawn + Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) + ScoreGiven:Word; //Score that has already been given to the Player + ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score + Next: PScorePopUp; //Next Item in List + end; + aScorePopUp = array of TScorePopUp; + + //----------- + // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups + //----------- + TSingScores = class + private + Positions: aScorePosition; + aPlayers: aScorePlayer; + oPositionCount: Byte; + oPlayerCount: Byte; + + //Saves the First and Last Popup of the List + FirstPopUp: PScorePopUp; + LastPopUp: PScorePopUp; + + //Procedure Draws a Popup by Pointer + Procedure DrawPopUp(const PopUp: PScorePopUp); + + //Procedure Draws a Score by Playerindex + Procedure DrawScore(const Index: Integer); + + //Procedure Removes a PopUp w/o destroying the List + Procedure KillPopUp(const last, cur: PScorePopUp); + public + Settings: record //Record containing some Displaying Options + Phase1Time: Real; //time for Phase 1 to complete (in msecs) + //The Plop Up of the PopUp + Phase2Time: Real; //time for Phase 2 to complete (in msecs) + //The Moving (mainly Upwards) of the Popup + Phase3Time: Real; //time for Phase 3 to complete (in msecs) + //The Fade out and Score adding + + PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating + + RatingBar_BG_Tex: TTexture; //Rating Bar Texs + RatingBar_FG_Tex: TTexture; + RatingBar_Bar_Tex: TTexture; + + end; + + //Propertys for Reading Position and Playercount + Property PositionCount: Byte read oPositionCount; + Property PlayerCount: Byte read oPlayerCount; + Property Players: aScorePlayer read aPlayers; + + //Constructor just sets some standard Settings + Constructor Create; + + //Procedure Adds a Position to Array and Increases Position Count + Procedure AddPosition(const pPosition: PScorePosition); + + //Procedure Adds a Player to Array and Increases Player Count + Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + + //Change a Players Visibility, Enable + Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); + Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + + //Procedure Deletes all Player Information + Procedure ClearPlayers; + + //Procedure Deletes Positions and Playerinformation + Procedure Clear; + + //Procedure Loads some Settings and the Positions from Theme + Procedure LoadfromTheme; + + //Procedure has to be called after Positions and Players have been added, before first call of Draw + //It gives every Player a Score Position + Procedure Init; + + //Spawns a new Line Bonus PopUp for the Player + Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + + //Removes all PopUps from Mem + Procedure KillAllPopUps; + + //Procedure Draws Scores and Linebonus PopUps + Procedure Draw; + end; + + +implementation +uses SDL, SysUtils, ULog, UGraphic, TextGL; + +//----------- +//Constructor just sets some standard Settings +//----------- +Constructor TSingScores.Create; +begin + //Clear PopupList Pointers + FirstPopUp := nil; + LastPopUp := nil; + + //Clear Position Index + oPositionCount := 0; + oPlayerCount := 0; + + Settings.Phase1Time := 1000; + Settings.Phase2Time := 2000; + Settings.Phase3Time := 2000; + + Settings.PopUpTex[0].TexNum := High(gluInt); + Settings.PopUpTex[1].TexNum := High(gluInt); + Settings.PopUpTex[2].TexNum := High(gluInt); + Settings.PopUpTex[3].TexNum := High(gluInt); + Settings.PopUpTex[4].TexNum := High(gluInt); + Settings.PopUpTex[5].TexNum := High(gluInt); + Settings.PopUpTex[6].TexNum := High(gluInt); + Settings.PopUpTex[7].TexNum := High(gluInt); + Settings.PopUpTex[8].TexNum := High(gluInt); + + Settings.RatingBar_BG_Tex.TexNum := High(gluInt); + Settings.RatingBar_FG_Tex.TexNum := High(gluInt); + Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); +end; + +//----------- +//Procedure Adds a Position to Array and Increases Position Count +//----------- +Procedure TSingScores.AddPosition(const pPosition: PScorePosition); +begin + if (PositionCount < MaxPositions) then + begin + Positions[PositionCount] := pPosition^; + + Inc(oPositionCount); + end; +end; + +//----------- +//Procedure Adds a Player to Array and Increases Player Count +//----------- +Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); +begin + if (PlayerCount < MaxPlayers) then + begin + aPlayers[PlayerCount].Position := High(byte); + aPlayers[PlayerCount].Enabled := Enabled; + aPlayers[PlayerCount].Visible := Visible; + aPlayers[PlayerCount].Score := Score; + aPlayers[PlayerCount].ScoreDisplayed := Score; + aPlayers[PlayerCount].ScoreBG := ScoreBG; + aPlayers[PlayerCount].Color := Color; + + Inc(oPlayerCount); + end; +end; + +//----------- +//Change a Players Visibility +//----------- +Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Visible := pVisible; +end; + +//----------- +//Change Player Enabled +//----------- +Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Enabled := pEnabled; +end; + +//----------- +//Procedure Deletes all Player Information +//----------- +Procedure TSingScores.ClearPlayers; +begin + KillAllPopUps; + oPlayerCount := 0; +end; + +//----------- +//Procedure Deletes Positions and Playerinformation +//----------- +Procedure TSingScores.Clear; +begin + KillAllPopUps; + oPlayerCount := 0; + oPositionCount := 0; +end; + +//----------- +//Procedure Loads some Settings and the Positions from Theme +//----------- +Procedure TSingScores.LoadfromTheme; +var I: Integer; + Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); + var nPosition: TScorePosition; + begin + nPosition.PlayerCount := PC; //Only for one Player Playing + + nPosition.BGX := ScoreStatic.X; + nPosition.BGY := ScoreStatic.Y; + nPosition.BGW := ScoreStatic.W; + nPosition.BGH := ScoreStatic.H; + + nPosition.TextX := ScoreText.X; + nPosition.TextY := ScoreText.Y; + nPosition.TextFont := ScoreText.Font; + nPosition.TextSize := ScoreText.Size; + + nPosition.RBX := SingBarStatic.X; + nPosition.RBY := SingBarStatic.Y; + nPosition.RBW := SingBarStatic.W; + nPosition.RBH := SingBarStatic.H; + + nPosition.PUW := nPosition.BGW; + nPosition.PUH := nPosition.BGH; + + nPosition.PUFont := 2; + nPosition.PUFontSize := 6; + + nPosition.PUStartX := nPosition.BGX; + nPosition.PUStartY := nPosition.TextY + 65; + + nPosition.PUTargetX := nPosition.BGX; + nPosition.PUTargetY := nPosition.TextY; + + AddPosition(@nPosition); + end; +begin + Clear; + + //Set Textures + //Popup Tex + For I := 0 to 8 do + Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; + + //Rating Bar Tex + Settings.RatingBar_BG_Tex := Tex_SingBar_Back; + Settings.RatingBar_FG_Tex := Tex_SingBar_Front; + Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; + + //Load Positions from Theme + + // Player1: + AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); + AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); + AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); + + // Player2: + AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); + AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); + + // Player3: + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); +end; + +//----------- +//Spawns a new Line Bonus PopUp for the Player +//----------- +Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); +var Cur: PScorePopUp; +begin + Log.LogError('Spawn PopUp: Score: ' + InttoStr(Score)); + if (PlayerIndex < PlayerCount) then + begin + //Get Memory and Add Data + GetMem(Cur, SizeOf(TScorePopUp)); + + Cur.Player := PlayerIndex; + Cur.TimeStamp := SDL_GetTicks; + Cur.Rating := Rating; + Cur.ScoreGiven:= 0; + If (Players[PlayerIndex].Score < Score) then + begin + Cur.ScoreDiff := Score - Players[PlayerIndex].Score; + aPlayers[PlayerIndex].Score := Score; + end + else + Cur.ScoreDiff := 0; + Cur.Next := nil; + + //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); + + //Add it to the Chain + if (FirstPopUp = nil) then + //the first PopUp in the List + FirstPopUp := Cur + else + //second or earlier popup + LastPopUp.Next := Cur; + + //Set new Popup to Last PopUp in the List + LastPopUp := Cur; + end + else + Log.LogError('TSingScores: Try to add PopUp for not existing player'); +end; + +//----------- +// Removes a PopUp w/o destroying the List +//----------- +Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +begin + //Give Player the Last Points that missing till now + aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; + + //If this is the First PopUp => Make Next PopUp the First + If (Cur = FirstPopUp) then + FirstPopUp := Cur.Next + //Else => Remove Curent Popup from Chain + else + Last.Next := Cur.Next; + + //If this is the Last PopUp, Make PopUp before the Last + If (Cur = LastPopUp) then + LastPopUp := Last; + + //Free the Memory + FreeMem(Cur, SizeOf(TScorePopUp)); +end; + +//----------- +//Removes all PopUps from Mem +//----------- +Procedure TSingScores.KillAllPopUps; +var + Cur: PScorePopUp; + Last: PScorePopUp; +begin + Cur := FirstPopUp; + + //Remove all PopUps: + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TScorePopUp)); + end; + + FirstPopUp := nil; + LastPopUp := nil; +end; + +//----------- +//Init - has to be called after Positions and Players have been added, before first call of Draw +//It gives every Player a Score Position +//----------- +Procedure TSingScores.Init; +var + PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen + I, J: Integer; + MaxPlayersperScreen: Byte; + CurPlayer: Byte; + + Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; + var I: Integer; + begin + Result := 0; + bPlayerCount := 1 shl (bPlayerCount - 1); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + Inc(Result); + end; + end; + + Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; + var I: Integer; + begin + bPlayerCount := 1 shl (bPlayerCount - 1); + Result := High(Byte); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + begin + If (bPlayer = 0) then + begin + Result := I; + Break; + end + else + Dec(bPlayer); + end; + end; + end; + +begin + + For I := 1 to 6 do + begin + //If there are enough Positions -> Write to MaxPlayers + If (GetPositionCountbyPlayerCount(I) = I) then + MaxPlayersperScreen := I + else + Break; + end; + + + //Split Players to both Screen or Display on One Screen + if (Screens = 2) and (MaxPlayersperScreen < PlayerCount) then + begin + PlC[0] := PlayerCount div 2 + PlayerCount mod 2; + PlC[1] := PlayerCount div 2; + end + else + begin + PlC[0] := PlayerCount; + PlC[1] := 0; + end; + + + //Check if there are enough Positions for all Players + For I := 0 to Screens - 1 do + begin + if (PlC[I] > MaxPlayersperScreen) then + begin + PlC[I] := MaxPlayersperScreen; + Log.LogError('More Players than available Positions, TSingScores'); + end; + end; + + CurPlayer := 0; + //Give every Player a Position + For I := 0 to Screens - 1 do + For J := 0 to PlC[I]-1 do + begin + aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); + //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); + Inc(CurPlayer); + end; +end; + +//----------- +//Procedure Draws Scores and Linebonus PopUps +//----------- +Procedure TSingScores.Draw; +var + I: Integer; + CurTime: Cardinal; + CurPopUp, LastPopUp: PScorePopUp; +begin + CurTime := SDL_GetTicks; + + //Draw Popups + LastPopUp := nil; + CurPopUp := FirstPopUp; + + While (CurPopUp <> nil) do + begin + if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + begin + KillPopUp(LastPopUp, CurPopUp); + if (LastPopUp = nil) then + CurPopUp := FirstPopUp + else + CurPopUp := LastPopUp.Next; + end + else + begin + DrawPopUp(CurPopUp); + LastPopUp := CurPopUp; + CurPopUp := LastPopUp.Next; + end; + end; + + + //Draw Players + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + end; +end; + +//----------- +//Procedure Draws a Popup by Pointer +//----------- +Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); +var + Progress: Real; + CurTime: Cardinal; + X, Y, W, H, Alpha: Real; + FontSize: Byte; + TimeDiff: Cardinal; + PIndex: Byte; + TextLen: Real; + ScoretoAdd: Word; + PosDiff: Real; +begin + if (PopUp <> nil) then + begin + //Only Draw if Player has a Position + PIndex := Players[PopUp.Player].Position; + If PIndex <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then + begin + CurTime := SDL_GetTicks; + TimeDiff := CurTime - PopUp.TimeStamp; + + //Get Position of PopUp + PIndex := PIndex AND 127; + + + //Check for Phase ... + If (TimeDiff <= Settings.Phase1Time) then + begin + //Phase 1 - The Ploping up + Progress := TimeDiff / Settings.Phase1Time; + + + W := Positions[PIndex].PUW * Sin(Progress/2*Pi); + H := Positions[PIndex].PUH * Sin(Progress/2*Pi); + + X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; + Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; + + FontSize := Round(Progress * Positions[PIndex].PUFontSize); + Alpha := 1; + end + + Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then + begin + //Phase 2 - The Moving + Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If PosDiff > 0 then + PosDiff := PosDiff + W; + X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If PosDiff < 0 then + PosDiff := PosDiff + Positions[PIndex].BGH; + Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); + + FontSize := Positions[PIndex].PUFontSize; + Alpha := 1 - 0.3 * Progress; + end + + else + begin + //Phase 3 - The Fading out + Score adding + Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; + + If (PopUp.Rating > 0) then + begin + //Add Scores + ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; + Inc(PopUp.ScoreGiven, ScoreToAdd); + aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + + //Set Positions etc. + Alpha := 0.7 - 0.7 * Progress; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If (PosDiff > 0) then + PosDiff := W + else + PosDiff := 0; + X := Positions[PIndex].PUTargetX + PosDiff * Progress; + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If (PosDiff < 0) then + PosDiff := -Positions[PIndex].BGH + else + PosDiff := 0; + Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); + + FontSize := Positions[PIndex].PUFontSize; + end + else + begin + //Here the Effect that Should be shown if a PopUp without Score is Drawn + //And or Spawn with the GraphicObjects etc. + //Some Work for Blindy to do :P + + //ATM: Just Let it Slide in the Scores just like the Normal PopUp + Alpha := 0; + end; + end; + + //Draw PopUp + + if (Alpha > 0) then + begin + //Draw BG: + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, Alpha); + glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Set FontStyle and Size + SetFontStyle(Positions[PIndex].PUFont); + SetFontItalic(False); + SetFontSize(FontSize); + + //Draw Text + TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + + //Color and Pos + SetFontPos (X + (W - TextLen) / 2, Y + 12); + glColor4f(1, 1, 1, Alpha); + + //Draw + glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + end; //eo Alpha check + end; //eo Right Screen + end; //eo Player has Position + end + else + Log.LogError('TSingScores: Try to Draw a not existing PopUp'); +end; + +//----------- +//Procedure Draws a Score by Playerindex +//----------- +Procedure TSingScores.DrawScore(const Index: Integer); +var + Position: PScorePosition; + ScoreStr: String; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) then + begin + Position := @Positions[Players[Index].Position and 127]; + + //Draw ScoreBG + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, 1); + glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); + glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Draw Score Text + SetFontStyle(Position.TextFont); + SetFontItalic(False); + SetFontSize(Position.TextSize); + SetFontPos(Position.TextX, Position.TextY); + + ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; + While (Length(ScoreStr) < 5) do + ScoreStr := '0' + ScoreStr; + + glPrint(PChar(ScoreStr)); + + end; //eo Right Screen + end; //eo Player has Position +end; + +end. -- cgit v1.2.3 From 739ad9a6dee57375f05dcd20dc59ba2d619f11fa Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 24 Sep 2007 13:31:43 +0000 Subject: fixed song loading in Lazarus.. cant assume variables are initialized as 0 :) in UFile "Done: byte;" was no initialized on lazarus compiler. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@431 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 106 ++- Game/Code/Classes/UFiles.pas | 13 +- Game/Code/Classes/USingScores.pas | 16 +- Game/Code/Classes/USongs.pas | 1509 +++++++++++++++++++------------------ Game/Code/Classes/UTexture.pas | 11 +- Game/Code/Classes/UThemes.pas | 25 +- 6 files changed, 862 insertions(+), 818 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index e8d5e878..5ce3ebf7 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -119,6 +119,9 @@ var begin ActFont := 0; + Log.LogStatus( '' , '---------------------------'); + + Log.LogStatus( 'Font' , '---------------------------'); SetLength(Fonts, 5); Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); Fonts[0].Tex.H := 30; @@ -126,18 +129,22 @@ begin Fonts[0].Done := -1; Fonts[0].Outline := 0; + Log.LogStatus( 'FontB' , '---------------------------'); + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 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', 'PNG', 'Font Outline', 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', 'PNG', 'Font Outline 2', 0); Fonts[3].Tex.H := 30; Fonts[3].AspectW := 0.95; @@ -212,41 +219,48 @@ var PR, PB: real; XItal: real; // X shift for italic type letter begin - with Fonts[ActFont].Tex do begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; -// H := 30; - - // 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; - - // 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; + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + // H := 30; + + // 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; + + // 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; - 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); - glEnd; - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); end; // with end; @@ -307,19 +321,33 @@ end; procedure glPrint(text: pchar); // Custom GL "Print" Routine var - Letter: char; +// Letter : char; + iPos : Integer; begin - if (Text = '') then // If There's No Text - Exit; // Do Nothing + if (Text = '') then // If There's No Text + Exit; // Do Nothing - while (length(text) > 0) do begin +(* + while (length(text) > 0) do + begin // cut Letter := Text[0]; - Text := pchar(Copy(Text, 2, Length(Text)-1)); + Text := pchar(Copy(Text, 2, Length(Text)-1)); // print glPrintLetter(Letter); end; // while +*) + + // 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; procedure glPrintCut(text: pchar); diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 34342e26..565c5ee3 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -137,11 +137,12 @@ end; //-------------------- function ReadTXTHeader(var Song: TSong): boolean; var -Line, Identifier, Value: String; -Temp: word; -Done: byte; + Line, Identifier, Value: String; + Temp: word; + Done: byte; begin Result := true; + Done := 0; //Read first Line ReadLn (SongFile, Line); @@ -167,6 +168,8 @@ begin Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + Log.LogError('Identifier: '+Identifier+' - '+ Value ); + //Check the Identifier (If Value is given) if (Length(Value) <> 0) then begin @@ -332,7 +335,7 @@ begin else begin Result := False; - Log.LogError('File Incomplete or not Ultrastar TxT: ' + Song.FileName); + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + Song.FileName); break; end; @@ -354,7 +357,7 @@ begin else if (Done and 1) = 0 then //No Title Flag Log.LogError('Title Tag Missing: ' + Song.FileName) else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT: ' + Song.FileName); + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + Song.FileName); end; end; diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 27a65b32..881a5515 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -1,7 +1,14 @@ unit USingScores; interface -uses UThemes, OpenGl12, UTexture; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses UThemes, + OpenGl12, + UTexture; //Some Constances containing Options that could change by time const @@ -158,7 +165,12 @@ type implementation -uses SDL, SysUtils, ULog, UGraphic, TextGL; + +uses SDL, + SysUtils, + ULog, + UGraphic, + TextGL; //----------- //Constructor just sets some standard Settings diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 301eb15c..e236abf0 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,753 +1,756 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -uses SysUtils, ULog, UTexture, UCatCovers; - -type - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: string; - Score: integer; - Length: string; - end; - - TSong = record - Path: string; - Folder: string; // for sorting by folder - FileName: string; - - // sorting methods - Category: array of string; // I think I won't need this - Genre: string; - Edition: string; - Language: string; // 0.5.0: new - - Title: string; - Artist: string; - - Text: string; - Creator: string; - - Cover: string; - CoverTex: TTexture; - Mp3: string; - Background: string; - Video: string; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - - TSongs = class - private - BrowsePos: Cardinal; //Actual Pos in Song Array - public - Song: array of TSong; // array of songs - Selected: integer; // selected song index - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: string); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: string): string; - end; - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) - -implementation - -uses StrUtils, - UFiles, - UMain, - UIni; - - -procedure TSongs.LoadSongList; -begin - Log.LogStatus('Initializing', 'LoadSongList'); - - // clear - Setlength(Song, 50); - - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); -// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); -end; - -procedure TSongs.BrowseDir(Dir: string); -var - SR: TSearchRec; // for parsing Songs Directory - SLen: integer; -begin - if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Dir + Sr.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - if FindFirst(Dir + '*.txt', 0, SR) = 0 then begin -// Log.LogStatus('Parsing file: ' + Dir + SR.Name + '\' + SRD.Name, 'LoadSongList'); - repeat - //New Mod for better Memory Management - - SLen := BrowsePos; - {//Old - SLen := Length(Song); - SetLength(Song, SLen + 1);//} - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) - else begin - // scanning complete, file is good - // if there is no cover then try to find it - if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); -// if Song[SLen].Background = '' then begin -// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); -// end; // no needed here} - - // fix by adding path. no, don't fix it. -// if Song[SLen].Cover <> '' then -// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNext(SR) <> 0; - end; // if FindFirst - FindClose(SR); -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: string): string; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := Low(Songs.Song) to High(Songs.Song) do begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := Songs.Song[S].Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := Songs.Song[S].Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := Songs.Song[S].Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Title[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Artist[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := Songs.Song[S].Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := Songs.Song[S]; - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +uses SysUtils, ULog, UTexture, UCatCovers; + +type + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: string; + Score: integer; + Length: string; + end; + + TSong = record + Path: string; + Folder: string; // for sorting by folder + FileName: string; + + // sorting methods + Category: array of string; // I think I won't need this + Genre: string; + Edition: string; + Language: string; // 0.5.0: new + + Title: string; + Artist: string; + + Text: string; + Creator: string; + + Cover: string; + CoverTex: TTexture; + Mp3: string; + Background: string; + Video: string; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class + private + BrowsePos: Cardinal; //Actual Pos in Song Array + public + Song: array of TSong; // array of songs + Selected: integer; // selected song index + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: string); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: string): string; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +implementation + +uses StrUtils, + UFiles, + UMain, + UIni; + + +procedure TSongs.LoadSongList; +begin + Log.LogStatus('Initializing', 'LoadSongList'); + + // clear + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); +// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); +end; + +procedure TSongs.BrowseDir(Dir: string); +var + SR: TSearchRec; // for parsing Songs Directory + SLen: integer; +begin + if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Dir + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + if FindFirst(Dir + '*.txt', 0, SR) = 0 then + begin + repeat + //New Mod for better Memory Management + +// Log.LogStatus('Parsing file: ' + Dir + SR.Name, 'LoadSongList'); + + + SLen := BrowsePos; + {//Old + SLen := Length(Song); + SetLength(Song, SLen + 1);//} + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) + else begin + // scanning complete, file is good + // if there is no cover then try to find it + if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); +// if Song[SLen].Background = '' then begin +// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); +// end; // no needed here} + + // fix by adding path. no, don't fix it. +// if Song[SLen].Cover <> '' then +// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNext(SR) <> 0; + end; // if FindFirst + FindClose(SR); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: string): string; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Title[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Artist[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +end. diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 3d746813..40a3a30b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -262,7 +262,7 @@ begin if ( FileExists(Identifier) ) then begin // load from file -// Log.LogStatus( 'Is File', ' LoadImage' ); + Log.LogStatus( 'Is File', ' LoadImage' ); try Result:=IMG_Load(Identifier); except @@ -273,7 +273,7 @@ begin end else begin -// Log.LogStatus( 'NOT File', ' LoadImage' ); + Log.LogStatus( 'IS Resource', ' LoadImage' ); // load from resource stream {$IFNDEF FPC} @@ -296,6 +296,7 @@ begin end; try + TexStream.position := 0; try TexRWops := SDL_AllocRW; TexRWops.unknown := TUnknown(TexStream); @@ -309,7 +310,8 @@ begin beep; Exit; end; - + + Log.LogStatus( 'resource Assigned....' , Identifier); Result:=IMG_Load_RW(TexRWops,0); SDL_FreeRW(TexRWops); @@ -340,9 +342,8 @@ begin Exit; end; - Result:=IMG_Load_RW(TexRWops,0); + Result := IMG_Load_RW(TexRWops,0); SDL_FreeRW(TexRWops); - finally freeandnil( lResData ); end; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 1e102987..9da176df 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -7,6 +7,7 @@ interface {$ENDIF} uses + ULog, IniFiles, SysUtils, Classes; @@ -1426,24 +1427,20 @@ var C: integer; begin DecimalSeparator := '.'; - ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0); + + 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.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.Font := ThemeIni.ReadInteger(Name, 'Font', 0); + ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); - {{$IFDEF TRANSLATE} - ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {{$ELSE}{ - ThemeText.Text := ThemeIni.ReadString(Name, 'Text', ''); - {$ENDIF} - + ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); C := ColorExists(ThemeText.Color); -- cgit v1.2.3 From a89edc606724e5d6d6fb36d81101d61c9f24b5fb Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 25 Sep 2007 18:50:13 +0000 Subject: Add Ratingbar to score class Ratingbar algorithm needs some finetuning. too much lowering atm Some atm not used functions of scoreclass don't work correctly. See USingScores. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@433 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USingScores.pas | 240 +++++++++++++++++++++++++++++++++----- 1 file changed, 212 insertions(+), 28 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 881a5515..052ff678 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -10,6 +10,16 @@ uses UThemes, OpenGl12, UTexture; +////////////////////////////////////////////////////////////// +// ATTENTION: // +// Enabled Flag does not Work atm. This should cause Popups // +// Not to Move and Scores to stay until Renenabling. // +// To use e.g. in Pause Mode // +// Also InVisible Flag causes Attributes not to change. // +// This should be fixed after next Draw when Visible = True,// +// but not testet yet // +////////////////////////////////////////////////////////////// + //Some Constances containing Options that could change by time const MaxPlayers = 6; //Maximum of Players that could be added @@ -27,6 +37,9 @@ type ScoreDisplayed: Word; //Score cur. Displayed(for counting up) ScoreBG: TTexture;//Texture of the Players Scores BG Color: TRGB; //Teh Players Color + RBPos: Real; //Cur. Percentille of the Rating Bar + RBTarget: Real; //Target Position of Rating Bar + RBVisible:Boolean; //Is Rating bar Drawn end; aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; @@ -103,6 +116,9 @@ type //Procedure Draws a Score by Playerindex Procedure DrawScore(const Index: Integer); + //Procedure Draws the RatingBar by Playerindex + Procedure DrawRatingBar(const Index: Integer); + //Procedure Removes a PopUp w/o destroying the List Procedure KillPopUp(const last, cur: PScorePopUp); public @@ -122,6 +138,10 @@ type end; + Visible: Boolean; //Visibility of all Scores + Enabled: Boolean; //Scores are changed, PopUps are Moved etc. + RBVisible: Boolean; //Visibility of all Rating Bars + //Propertys for Reading Position and Playercount Property PositionCount: Byte read oPositionCount; Property PlayerCount: Byte read oPlayerCount; @@ -180,6 +200,11 @@ begin //Clear PopupList Pointers FirstPopUp := nil; LastPopUp := nil; + + //Clear Variables + Visible := True; + Enabled := True; + RBVisible := True; //Clear Position Index oPositionCount := 0; @@ -231,6 +256,9 @@ begin aPlayers[PlayerCount].ScoreDisplayed := Score; aPlayers[PlayerCount].ScoreBG := ScoreBG; aPlayers[PlayerCount].Color := Color; + aPlayers[PlayerCount].RBPos := 0.5; + aPlayers[PlayerCount].RBTarget := 0.5; + aPlayers[PlayerCount].RBVisible := True; Inc(oPlayerCount); end; @@ -390,6 +418,13 @@ begin //Give Player the Last Points that missing till now aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; + //Change Bars Position + aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven)/Cur.ScoreDiff * (Cur.Rating / 20 - 0.26); + If (aPlayers[Cur.Player].RBTarget > 1) then + aPlayers[Cur.Player].RBTarget := 1 + else If (aPlayers[Cur.Player].RBTarget < 0) then + aPlayers[Cur.Player].RBTarget := 0; + //If this is the First PopUp => Make Next PopUp the First If (Cur = FirstPopUp) then FirstPopUp := Cur.Next @@ -528,35 +563,47 @@ var CurPopUp, LastPopUp: PScorePopUp; begin CurTime := SDL_GetTicks; - - //Draw Popups - LastPopUp := nil; - CurPopUp := FirstPopUp; - - While (CurPopUp <> nil) do + + If Visible then begin - if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + //Draw Popups + LastPopUp := nil; + CurPopUp := FirstPopUp; + + While (CurPopUp <> nil) do begin - KillPopUp(LastPopUp, CurPopUp); - if (LastPopUp = nil) then - CurPopUp := FirstPopUp + if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + begin + KillPopUp(LastPopUp, CurPopUp); + if (LastPopUp = nil) then + CurPopUp := FirstPopUp + else + CurPopUp := LastPopUp.Next; + end else + begin + DrawPopUp(CurPopUp); + LastPopUp := CurPopUp; CurPopUp := LastPopUp.Next; - end - else - begin - DrawPopUp(CurPopUp); - LastPopUp := CurPopUp; - CurPopUp := LastPopUp.Next; + end; end; - end; - //Draw Players - For I := 0 to PlayerCount-1 do - begin - DrawScore(I); - end; + IF (RBVisible) then + //Draw Players w/ Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + DrawRatingBar(I); + end + else + //Draw Players w/o Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + end; + + end; //eo Visible end; //----------- @@ -584,6 +631,11 @@ begin If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then begin CurTime := SDL_GetTicks; + If Not (Enabled AND Players[PopUp.Player].Enabled) then + //Increase Timestamp with TIem where there is no Movement ... + begin + //Inc(PopUp.TimeStamp, LastRender); + end; TimeDiff := CurTime - PopUp.TimeStamp; //Get Position of PopUp @@ -636,10 +688,20 @@ begin If (PopUp.Rating > 0) then begin - //Add Scores - ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; - Inc(PopUp.ScoreGiven, ScoreToAdd); - aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + //Add Scores if Player Enabled + If (Enabled AND Players[PopUp.Player].Enabled) then + begin + ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; + Inc(PopUp.ScoreGiven, ScoreToAdd); + aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + + //Change Bars Position + aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); + If (aPlayers[PopUp.Player].RBTarget > 1) then + aPlayers[PopUp.Player].RBTarget := 1 + else If (aPlayers[PopUp.Player].RBTarget < 0) then + aPlayers[PopUp.Player].RBTarget := 0; + end; //Set Positions etc. Alpha := 0.7 - 0.7 * Progress; @@ -676,7 +738,7 @@ begin //Draw PopUp - if (Alpha > 0) then + if (Alpha > 0) AND (Players[PopUp.Player].Visible) then begin //Draw BG: glEnable(GL_TEXTURE_2D); @@ -730,7 +792,7 @@ begin If Players[Index].Position <> high(byte) then begin //Only Draw if Player is on Cur Screen - If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) then + If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then begin Position := @Positions[Players[Index].Position and 127]; @@ -768,4 +830,126 @@ begin end; //eo Player has Position end; + +Procedure TSingScores.DrawRatingBar(const Index: Integer); +var + Position: PScorePosition; + R,G,B, Size: Real; + Diff: Real; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) AND (Players[index].RBVisible AND Players[index].Visible) then + begin + Position := @Positions[Players[Index].Position and 127]; + + If (Enabled AND Players[Index].Enabled) then + begin + //Move Position if Enabled + Diff := Players[Index].RBTarget - Players[Index].RBPos; + If(Abs(Diff) < 0.02) then + aPlayers[Index].RBPos := aPlayers[Index].RBTarget + else + aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; + end; + + //Get Colors for RatingBar + If Players[index].RBPos <=0.22 then + begin + R := 1; + G := 0; + B := 0; + end + Else If Players[index].RBPos <=0.42 then + begin + R := 1; + G := Players[index].RBPos*5; + B := 0; + end + Else If Players[index].RBPos <=0.57 then + begin + R := 1; + G := 1; + B := 0; + end + Else If Players[index].RBPos <=0.77 then + begin + R := 1-(Players[index].RBPos-0.57)*5; + G := 1; + B := 0; + end + else + begin + R := 0; + G := 1; + B := 0; + end; + + //Enable all glFuncs Needed + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //Draw RatingBar BG + glColor4f(1, 1, 1, 0.8); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); + glVertex2f(Position.RBX+Position.RBW, Position.RBY); + glEnd; + + //Draw Rating bar itself + Size := Position.RBX + Position.RBW * Players[Index].RBPos; + glColor4f(R, G, B, 1); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Size, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); + glVertex2f(Size, Position.RBY); + glEnd; + + //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) + glColor4f(1, 1, 1, 0.6); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); + glVertex2f(Position.RBX + Position.RBW, Position.RBY); + glEnd; + + //Disable all Enabled glFuncs + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end; //eo Right Screen + end; //eo Player has Position +end; + end. -- cgit v1.2.3 From 1acdd4a165647aa45d44f537326506d97c90c121 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 25 Sep 2007 18:59:00 +0000 Subject: Some Cleanup in UDraw, UMain and UScreenSing Removed some old, yet not used functions One class todo(Notes) then the dirty UDraw will be a thing of the past. Also Player and Notes Array needs some rewriting. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@434 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 312 +------------------------------------------- Game/Code/Classes/UMain.pas | 21 +-- 2 files changed, 3 insertions(+), 330 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 5a175289..1e631648 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -23,12 +23,6 @@ procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: inte // TimeBar procedure SingDrawTimeBar(); -// The Singbar -procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); - -//Phrasen Bonus - Line Bonus -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); - //Draw Editor NoteLines procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); @@ -530,15 +524,8 @@ var BarWspol: real; TempCol: real; Tekst: string; - LyricTemp: string; PetCz: integer; - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - begin // positions if Ini.SingWindow = 0 then begin @@ -656,135 +643,7 @@ begin end; end; - end - - //SingBar Mod - //modded again to make it moveable: it's working, so why try harder - else if Ini.Oscilloscope = 2 then - begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; end; - //end Singbar Mod - - {//PhrasenBonus - Line Bonus Mod - if Ini.LineBonus > 0 then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // shift position of the pop up (if not dead) - end; // loop - for all players - end; // if - linebonus - - - if PlayersPlay = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; - end; - //PhrasenBonus - Line Bonus Mod End } // Set the note heights according to the difficulty level case Ini.Difficulty of @@ -925,15 +784,7 @@ var BarWspol: real; TempCol: real; Tekst: string; - LyricTemp: string; PetCz: integer; - - //SingBar Mod - A: Integer; - E: Integer; - I: Integer; - //end Singbar Mod - begin // positions if Ini.SingWindow = 0 then begin @@ -1055,166 +906,7 @@ begin end; end; - end - - //SingBar Mod - // seems like we don't want the flicker thing, we want the linebonus rating bar beneath the scores - else if ((Ini.Oscilloscope = 2) AND (DLLMan.Selected.ShowRateBar_O)) OR (DLLMan.Selected.ShowRateBar) then begin - A := GetTickCount div 33; - if A <> Tickold then begin - Tickold := A; - for E := 0 to (PlayersPlay - 1) do begin //Set new Pos + Alpha - I := Player[E].ScorePercentTarget - Player[E].ScorePercent; - if I > 0 then Inc(Player[E].ScorePercent) - else if I < 0 then Dec(Player[E].ScorePercent); - end; //for - end; //if - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1SingBar.x, Theme.Sing.StaticP1SingBar.y, Theme.Sing.StaticP1SingBar.w, Theme.Sing.StaticP1SingBar.h , Player[0].ScorePercent); - end; - - if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - - if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[1].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1TwoPSingBar.x, Theme.Sing.StaticP1TwoPSingBar.y, Theme.Sing.StaticP1TwoPSingBar.w, Theme.Sing.StaticP1TwoPSingBar.h , Player[2].ScorePercent); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2RSingBar.x, Theme.Sing.StaticP2RSingBar.y, Theme.Sing.StaticP2RSingBar.w, Theme.Sing.StaticP2RSingBar.h , Player[3].ScorePercent); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[0].ScorePercent); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[1].ScorePercent); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[2].ScorePercent); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawSingbar(Theme.Sing.StaticP1ThreePSingBar.x, Theme.Sing.StaticP1ThreePSingBar.y, Theme.Sing.StaticP1ThreePSingBar.w, Theme.Sing.StaticP1ThreePSingBar.h , Player[3].ScorePercent); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawSingbar(Theme.Sing.StaticP2MSingBar.x, Theme.Sing.StaticP2MSingBar.y, Theme.Sing.StaticP2MSingBar.w, Theme.Sing.StaticP2MSingBar.h , Player[4].ScorePercent); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawSingbar(Theme.Sing.StaticP3SingBar.x, Theme.Sing.StaticP3SingBar.y, Theme.Sing.StaticP3SingBar.w, Theme.Sing.StaticP3SingBar.h , Player[5].ScorePercent); - end; - end; - end; - //end Singbar Mod - - {//PhrasenBonus - Line Bonus Mod - if ((Ini.LineBonus > 0) AND (DLLMan.Selected.EnLineBonus_O)) OR (DLLMan.Selected.EnLineBonus) then begin - A := GetTickCount div 33; - if (A <> Tickold2) AND (Player[0].LineBonus_Visible) then begin - Tickold2 := A; - for E := 0 to (PlayersPlay - 1) do begin - //Change Alpha - Player[E].LineBonus_Alpha := Player[E].LineBonus_Alpha - 0.02; - - if Player[E].LineBonus_Alpha <= 0 then - begin - Player[E].LineBonus_Age := 0; - Player[E].LineBonus_Visible := False - end - else - begin - inc(Player[E].LineBonus_Age, 1); - //Change Position - if (Player[E].LineBonus_PosX < Player[E].LineBonus_TargetX) then // pop up has not yet reached it's position -> blend in - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosX > Player[E].LineBonus_TargetX) then // pop up has reached it's position -> blend out - Player[E].LineBonus_PosX := Player[E].LineBonus_PosX - (2 - Player[E].LineBonus_Alpha * 1.5); - - if (Player[E].LineBonus_PosY < Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY + (2 - Player[E].LineBonus_Alpha * 1.5) - else if (Player[E].LineBonus_PosY > Player[E].LineBonus_TargetY) then - Player[E].LineBonus_PosY := Player[E].LineBonus_PosY - (2 - Player[E].LineBonus_Alpha * 1.5); - - end; // pop up still visible, has not reached it's position - move it - end; // loop through all players - end; // if it's time to draw them - - if PlayersPlay = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - end - - else if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end - - else if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end - - else if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - end; - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawLineBonus( Player[0].LineBonus_PosX, Player[0].LineBonus_PosY, Player[0].LineBonus_Color, Player[0].LineBonus_Alpha, Player[0].LineBonus_Text, Player[0].LineBonus_Age); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawLineBonus( Player[1].LineBonus_PosX, Player[1].LineBonus_PosY, Player[1].LineBonus_Color, Player[1].LineBonus_Alpha, Player[1].LineBonus_Text, Player[1].LineBonus_Age); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawLineBonus( Player[2].LineBonus_PosX, Player[2].LineBonus_PosY, Player[2].LineBonus_Color, Player[2].LineBonus_Alpha, Player[2].LineBonus_Text, Player[2].LineBonus_Age); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawLineBonus( Player[3].LineBonus_PosX, Player[3].LineBonus_PosY, Player[3].LineBonus_Color, Player[3].LineBonus_Alpha, Player[3].LineBonus_Text, Player[3].LineBonus_Age); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawLineBonus( Player[4].LineBonus_PosX, Player[4].LineBonus_PosY, Player[4].LineBonus_Color, Player[4].LineBonus_Alpha, Player[4].LineBonus_Text, Player[4].LineBonus_Age); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawLineBonus( Player[5].LineBonus_PosX, Player[5].LineBonus_PosY, Player[5].LineBonus_Color, Player[5].LineBonus_Alpha, Player[5].LineBonus_Text, Player[5].LineBonus_Age); - end; - end; end; -//PhrasenBonus - Line Bonus Mod End } // resize the notes according to the difficulty level case Ini.Difficulty of @@ -1345,7 +1037,7 @@ begin end; -//SingBar Mod +{//SingBar Mod procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); var R: Real; @@ -1474,7 +1166,7 @@ if Age < 5 then Size := Age * 10 else Size := 50; glPrint (PChar(Text)); end; end; -//PhrasenBonus - Line Bonus Mod +//PhrasenBonus - Line Bonus Mod} // Draw Note Bars for Editor //There are 11 Resons for a new Procdedure: diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 1970730a..878ff35c 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -43,27 +43,8 @@ type - //SingBar Mod + //LineBonus Mod ScoreLast: Real;//Last Line Score - ScorePercent: integer;//Aktual Fillstate of the SingBar - ScorePercentTarget: integer;//Target Fillstate of the SingBar - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: Single; - LineBonus_PosY: Single; - LineBonus_Alpha: Single; - LineBonus_Visible: boolean; - LineBonus_Text: string; - LineBonus_Color: TRGB; - LineBonus_Age: Integer; - LineBonus_Rating: Integer; - //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes - LineBonus_TargetX: integer; - LineBonus_TargetY: integer; - LineBonus_StartX: integer; - LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End //PerfectLineTwinkle Mod (effect) LastSentencePerfect: Boolean; -- cgit v1.2.3 From 2221d3db9408f3d7c6ee0ab0cc024e253cac80e0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 27 Sep 2007 11:58:51 +0000 Subject: fixed compile error from whiteshark.. now it compiles :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@435 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 878ff35c..8dd8c0a3 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -45,6 +45,26 @@ type //LineBonus Mod ScoreLast: Real;//Last Line Score + ScorePercent: integer;//Aktual Fillstate of the SingBar + ScorePercentTarget: integer;//Target Fillstate of the SingBar + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + LineBonus_PosX: Single; + LineBonus_PosY: Single; + LineBonus_Alpha: Single; + LineBonus_Visible: boolean; + LineBonus_Text: string; + LineBonus_Color: TRGB; + LineBonus_Age: Integer; + LineBonus_Rating: Integer; + //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes + LineBonus_TargetX: integer; + LineBonus_TargetY: integer; + LineBonus_StartX: integer; + LineBonus_StartY: integer; + //PhrasenBonus - Line Bonus Mod End + //PerfectLineTwinkle Mod (effect) LastSentencePerfect: Boolean; -- cgit v1.2.3 From bf3cb9322bc1f582061b489ddf7a65c681fafed5 Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 27 Sep 2007 22:33:35 +0000 Subject: Loading of Covers should now work (should be tested) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@441 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 122 ++++++++++++++++++++++++++++++----------- 1 file changed, 91 insertions(+), 31 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 40a3a30b..76eab676 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,4 +1,6 @@ unit UTexture; +// added for easier debug disabling +//{$define blindydebug} // Plain (alpha = 1) // Transparent @@ -111,6 +113,8 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; end; var @@ -133,6 +137,7 @@ var Mipmapping: Boolean; CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; implementation @@ -143,7 +148,7 @@ uses ULog, {$IFDEF FPC} LResources, {$ENDIF} - StrUtils; + StrUtils, dialogs; const fmt_rgba: TSDL_Pixelformat=(palette: nil; @@ -182,6 +187,16 @@ const Alpha: 255); +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; begin if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and @@ -364,10 +379,14 @@ var NeededPixFmt: PSDL_Pixelformat; begin NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else if (Typ='Transparent') or (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba; + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then begin @@ -489,43 +508,58 @@ var MipmapSurface: PSDL_Surface; newWidth, newHeight: Cardinal; oldWidth, oldHeight: Cardinal; - + kopierindex: Cardinal; begin Log.BenchmarkStart(4); Mipmapping := true; - - - (* Log.LogStatus( '', '' ); - + if Identifier = nil then Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') else Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); *) - // load texture data into memory + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} if not assigned(TexSurface) then begin Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); beep; Exit; end; - - // convert pixel format as needed + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} AdjustPixelFormat(TexSurface, Typ); - - // adjust texture size (scale down, if necessary) - newWidth:=TexSurface^.W; + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth:=TexSurface.W; newHeight:=TexSurface.H; if (newWidth > Limit) then newWidth:=Limit; if (newHeight > Limit) then newHeight:=Limit; - if (TexSurface.W > newWidth) or (TexSurface^.H > newHeight) then + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; // don't actually understand, if this is needed... // this should definately be changed... together with all this @@ -534,21 +568,43 @@ begin begin if (Covers.W <= 256) and (Covers.H <= 256) then begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - System.Move(MipmapSurface^.pixels,CacheMipmap,Covers.W*Covers.H*3-1); - SDL_FreeSurface(MipmapSurface); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; end; // should i create a cache texture, if Covers.W/H are larger? end; - - // now we might colorize the whole thing + // now we might colorize the whole thing if Typ='Colorized' then ColorizeTexture(TexSurface,Col); - - // save actual dimensions of our texture + // save actual dimensions of our texture oldWidth:=newWidth; oldHeight:=newHeight; - // make texture dimensions be powers of 2 + // make texture dimensions be powers of 2 newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); if (newHeight <> oldHeight) or (newWidth <> oldWidth) then @@ -564,21 +620,19 @@ begin // then we're done manipulating it // and could now create our openGL texture from it - // prepare OpenGL texture + // prepare OpenGL texture glGenTextures(1, ActTex); glBindTexture(GL_TEXTURE_2D, ActTex); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if Typ = 'Plain' then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface^.pixels); - end; - + // load data into gl texture if (Typ = 'Transparent') or (Typ='Colorized') then begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface^.pixels); + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); end; { if Typ = 'Transparent Range' then @@ -908,7 +962,13 @@ begin if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} end; // use texture -- cgit v1.2.3 From 4ae028b8f6e105f2628303a4f8bacbb6f7bcb93a Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 27 Sep 2007 23:01:40 +0000 Subject: TextGL.pas: changed text blendmode... most texts should be readable UDisplay.pas: disabled Screenshot code, something's broken (it's called without me even getting close to the print button), maybe we can fix this and rewrite everything to use SDL_Image (any thoughts on this?) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@442 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 5ce3ebf7..c73908f8 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -245,7 +245,7 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR); glBindTexture(GL_TEXTURE_2D, TexNum); glBegin(GL_QUADS); @@ -304,7 +304,7 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR); glBindTexture(GL_TEXTURE_2D, TexNum); glBegin(GL_QUADS); glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); -- cgit v1.2.3 From e5b70a52b5fc4a572136a3a07ee2f5e443c5e52b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 28 Sep 2007 13:57:52 +0000 Subject: Reremoved old TPlayer attributes and removed some code fragments that still links to these attributes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@444 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 8dd8c0a3..9b6ea3d5 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -45,7 +45,7 @@ type //LineBonus Mod ScoreLast: Real;//Last Line Score - ScorePercent: integer;//Aktual Fillstate of the SingBar + {ScorePercent: integer;//Aktual Fillstate of the SingBar ScorePercentTarget: integer;//Target Fillstate of the SingBar //end Singbar Mod @@ -63,7 +63,7 @@ type LineBonus_TargetY: integer; LineBonus_StartX: integer; LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End + //PhrasenBonus - Line Bonus Mod End } //PerfectLineTwinkle Mod (effect) @@ -736,20 +736,6 @@ begin Player[PlayerNum].ScoreGolden := 0; Player[PlayerNum].ScoreGoldenI := 0; Player[PlayerNum].ScoreTotalI := 0; - - - //SingBar Mod - Player[PlayerNum].ScoreLast := 0; - Player[PlayerNum].ScorePercent := 50;// Sets to 50% when song starts - Player[PlayerNum].ScorePercentTarget := 50;// Sets to 50% when song starts - //end SingBar Mod - - //PhrasenBonus - Line Bonus Mod - Player[PlayerNum].LineBonus_Visible := False; //Hide Line Bonus - Player[PlayerNum].LineBonus_Alpha := 0; - Player[PlayerNum].LineBonus_TargetX := 70 + PlayerNum*500; - Player[PlayerNum].LineBonus_TargetY := 30; - //PhrasenBonus - Line Bonus Mod End end; //-------------------- -- cgit v1.2.3 From 95662b4cb8252ae665de8222762f9fc320f11ea0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 29 Sep 2007 01:47:49 +0000 Subject: small fixes for lazarus build. cleanup on some code. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@445 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCovers.pas | 511 +++++++++++++++++++++-------------------- Game/Code/Classes/UGraphic.pas | 5 - Game/Code/Classes/UMusic.pas | 2 +- Game/Code/Classes/UTexture.pas | 3 +- 4 files changed, 266 insertions(+), 255 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 094fe43c..966277cd 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -1,248 +1,263 @@ -unit UCovers; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - UThemes, - UTexture; - -type - TCover = record - Name: string; - W: word; - H: word; - Size: integer; - Position: integer; // position of picture in the cache file -// Data: array of byte; - end; - - TCovers = class - Cover: array of TCover; - W: word; - H: word; - Size: integer; - Data: array of byte; - WritetoFile: Boolean; - - constructor Create; - procedure Load; - procedure Save; - procedure AddCover(Name: string); - function CoverExists(Name: string): boolean; - function CoverNumber(Name: string): integer; - procedure PrepareData(Name: string); - end; - -var - Covers: TCovers; - -implementation - -uses UMain, - // UFiles, - ULog, - DateUtils; - -constructor TCovers.Create; -begin - W := 128; - H := 128; - Size := W*H*3; - Load; - WritetoFile := True; -end; - -procedure TCovers.Load; -var - F: File; - C: integer; // cover number - W: word; - H: word; - Bits: byte; - NLen: word; - Name: string; -// Data: array of byte; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); - - SetLength(Cover, 0); - - while not EOF(F) do - begin - SetLength(Cover, Length(Cover)+1); - - BlockRead(F, W, 2); - Cover[High(Cover)].W := W; - - BlockRead(F, H, 2); - Cover[High(Cover)].H := H; - - BlockRead(F, Bits, 1); - - Cover[High(Cover)].Size := W * H * (Bits div 8); - - // test - // W := 128; - // H := 128; - // Bits := 24; - // Seek(F, FilePos(F) + 3); - - BlockRead(F, NLen, 2); - SetLength(Name, NLen); - - BlockRead(F, Name[1], NLen); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].Position := FilePos(F); - Seek(F, FilePos(F) + W*H*(Bits div 8)); - - // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); - // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); - - end; // While - - CloseFile(F); - end; // fileexists -end; - -procedure TCovers.Save; -var - F: File; - C: integer; // cover number - W: word; - H: word; - NLen: word; - Bits: byte; -begin -{ AssignFile(F, GamePath + 'covers.cache'); - Rewrite(F, 1); - - Bits := 24; - for C := 0 to High(Cover) do begin - W := Cover[C].W; - H := Cover[C].H; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Cover[C].Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Cover[C].Name[1], NLen); - BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); - end; - - CloseFile(F);} -end; - -procedure TCovers.AddCover(Name: string); -var - B: integer; - F: File; - C: integer; // cover number - NLen: word; - Bits: byte; -begin - if not CoverExists(Name) then begin - SetLength(Cover, Length(Cover)+1); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].W := W; - Cover[High(Cover)].H := H; - Cover[High(Cover)].Size := Size; - - // do not copy data. write them directly to file -// SetLength(Cover[High(Cover)].Data, Size); -// for B := 0 to Size-1 do -// Cover[High(Cover)].Data[B] := CacheMipmap[B]; - - if WritetoFile then - begin - AssignFile(F, GamePath + 'covers.cache'); - if FileExists(GamePath + 'covers.cache') then begin - Reset(F, 1); - Seek(F, FileSize(F)); - end else - Rewrite(F, 1); - - Bits := 24; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Name[1], NLen); - - Cover[High(Cover)].Position := FilePos(F); - BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); - - CloseFile(F); - end; - end - else - Cover[High(Cover)].Position := 0; -end; - -function TCovers.CoverExists(Name: string): boolean; -var - C: integer; // cover -begin - Result := false; - C := 0; - while (C <= High(Cover)) and (Result = false) do begin - if Cover[C].Name = Name then Result := true; - Inc(C); - end; -end; - -function TCovers.CoverNumber(Name: string): integer; -var - C: integer; -begin - Result := -1; - C := 0; - while (C <= High(Cover)) and (Result = -1) do begin - if Cover[C].Name = Name then Result := C; - Inc(C); - end; -end; - -procedure TCovers.PrepareData(Name: string); -var - F: File; - C: integer; -begin - if FileExists(GamePath + 'covers.cache') then begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - C := CoverNumber(Name); - SetLength(Data, Cover[C].Size); - if Length(Data) < 6 then beep; - Seek(F, Cover[C].Position); - BlockRead(F, Data[0], Cover[C].Size); - CloseFile(F); - end; -end; - -end. +unit UCovers; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation + +uses UMain, + // UFiles, + ULog, + DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; // While + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then + begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + + if FileExists(GamePath + 'covers.cache') then + begin + Reset(F, 1); + Seek(F, FileSize(F)); + end + else + begin + Rewrite(F, 1); + end; + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + + while (C <= High(Cover)) and (Result = false) do + begin + if Cover[C].Name = Name then + Result := true; + + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + + while (C <= High(Cover)) and (Result = -1) do + begin + if Cover[C].Name = Name then + Result := C; + + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 6ea89c0f..44c068a0 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -312,9 +312,6 @@ begin Log.LogStatus('Loading Textures - C', 'LoadTextures'); - {$IFNDEF FPC} - // TODO : jb_FPC why does this cause lazarus build, to have runtime error.. - // TODO : jb_FPC - START HERE !! //Line Bonus PopUp for P := 0 to 8 do begin @@ -357,8 +354,6 @@ begin Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); end; - {$ENDIF} - Log.LogStatus('Loading Textures - D', 'LoadTextures'); end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index b9ed47b4..b9f93b29 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -233,7 +233,7 @@ begin if not BASS_Init(1, 44100, 0, fHWND, nil) then begin {$IFNDEF FPC} - // TODO : JB_lazarus find a way to do this nice.. + // TODO : JB_linux find a way to do this nice.. Application.MessageBox ('Could not initialize BASS', 'Error'); {$ENDIF} Exit; diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 76eab676..eb01b4c4 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -980,7 +980,8 @@ begin // use cache texture C := Covers.CoverNumber(Name); - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin // load texture Covers.PrepareData(Name); TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); -- cgit v1.2.3 From 76616a7974a926ddee09ab605f89acc78321e728 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 29 Sep 2007 03:24:33 +0000 Subject: fixed runtime sing errors, when compiled in lazarus. mainly divide by 0 errors. need to be more careful with these, as they can be a pain to track down git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@446 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 48 +++++++++++++++++++++++++++++++++++++-- Game/Code/Classes/USingScores.pas | 35 ++++++++++++++++++++++++++-- 2 files changed, 79 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 1e631648..22b1263d 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -221,6 +221,9 @@ var PlayerNumber: Integer; GoldenStarPos : real; + + lTmpA , + lTmpB : real; begin // We actually don't have a playernumber in this procedure, it should reside in NrCzesci - but it's always set to zero // So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci to zero @@ -236,7 +239,26 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + lTmpA := (Right-Left); + lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); + writeln( 'UDRAW : ' + floattostr( lTmpB ) ); + writeln( '' ); + + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin for Pet := 0 to HighNut do begin with Nuta[Pet] do begin @@ -440,13 +462,35 @@ var R,G,B: real; X1, X2, X3, X4: real; W, H: real; + + lTmpA , + lTmpB : real; begin if (Player[NrGracza].ScoreTotalI >= 0) then begin glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + + lTmpA := (Right-Left); + lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); + writeln( 'UDRAW : ' + floattostr( lTmpB ) ); + writeln( '' ); + + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin for Pet := 0 to HighNut do begin with Nuta[Pet] do begin diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 052ff678..88b278b7 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -414,15 +414,46 @@ end; // Removes a PopUp w/o destroying the List //----------- Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +var + lTempA , + lTempB : real; begin //Give Player the Last Points that missing till now aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; //Change Bars Position - aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven)/Cur.ScoreDiff * (Cur.Rating / 20 - 0.26); + + // TODO : JB_Lazarus - Exception=Invalid floating point operation + // AT THIS LINE ! + + writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); + writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); + writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); + writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); + writeln( '' ); + + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); + writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); + writeln( '----------------------------------------------------------' ); + + + if ( lTempA > 0 ) AND + ( lTempB > 0 ) THEN + begin + writeln( 'USINGSCORES-lTempA / lTempB :' + floattostr( lTempA / lTempB ) ); + aPlayers[Cur.Player].RBTarget := lTempA / lTempB; + end; + + writeln( '----------------------------------------------------------' ); + writeln( '' ); + If (aPlayers[Cur.Player].RBTarget > 1) then aPlayers[Cur.Player].RBTarget := 1 - else If (aPlayers[Cur.Player].RBTarget < 0) then + else + If (aPlayers[Cur.Player].RBTarget < 0) then aPlayers[Cur.Player].RBTarget := 0; //If this is the First PopUp => Make Next PopUp the First -- cgit v1.2.3 From 7a08105b029d22762039d9b6c66494cab85cfc49 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 29 Sep 2007 03:38:24 +0000 Subject: removed debug code from previous checkin. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@447 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 10 ++++++++-- Game/Code/Classes/USingScores.pas | 15 +++++++++------ 2 files changed, 17 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 22b1263d..90a3875b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -243,10 +243,13 @@ begin lTmpA := (Right-Left); lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + {$IFDEF FPC} +(* writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); writeln( 'UDRAW : ' + floattostr( lTmpB ) ); writeln( '' ); - +*) + {$ENFIF} if ( lTmpA > 0 ) AND ( lTmpB > 0 ) THEN @@ -476,10 +479,13 @@ begin lTmpA := (Right-Left); lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + {$IFDEF FPC} +{* writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); writeln( 'UDRAW : ' + floattostr( lTmpB ) ); writeln( '' ); - +*} + {$ENDIF} if ( lTmpA > 0 ) AND ( lTmpB > 0 ) THEN diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 88b278b7..7625c17c 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -426,30 +426,33 @@ begin // TODO : JB_Lazarus - Exception=Invalid floating point operation // AT THIS LINE ! + {$IFDEF FPC} +(* writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); writeln( '' ); +*) + {$ENDIF} lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); - + + {$IFDEF FPC} +(* writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); writeln( '----------------------------------------------------------' ); - +*) + {$ENDIF} if ( lTempA > 0 ) AND ( lTempB > 0 ) THEN begin - writeln( 'USINGSCORES-lTempA / lTempB :' + floattostr( lTempA / lTempB ) ); aPlayers[Cur.Player].RBTarget := lTempA / lTempB; end; - writeln( '----------------------------------------------------------' ); - writeln( '' ); - If (aPlayers[Cur.Player].RBTarget > 1) then aPlayers[Cur.Player].RBTarget := 1 else -- cgit v1.2.3 From 4ef0a0f9d2de3483107e7c2961ffb063757ad944 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 29 Sep 2007 03:42:24 +0000 Subject: oops :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@448 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 90a3875b..a8404355 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -249,7 +249,7 @@ begin writeln( 'UDRAW : ' + floattostr( lTmpB ) ); writeln( '' ); *) - {$ENFIF} + {$ENDIF} if ( lTmpA > 0 ) AND ( lTmpB > 0 ) THEN -- cgit v1.2.3 From 82621bfeb1ccbda7425b5d11b8315a9cb91509c2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sun, 30 Sep 2007 04:54:03 +0000 Subject: fixed credits screen in lazarus build. ( now looks and operates the same as delphi build ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@450 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index eb01b4c4..f5169e8c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -//{$define blindydebug} +{$define blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From fac1634f48835f46249ec25d2758c81addd09d52 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sun, 30 Sep 2007 05:56:29 +0000 Subject: some minor bug fixes.. added Installer script.. for NSIS install compiler. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@451 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 41 ----------------------------------------- Game/Code/Classes/UMain.pas | 16 ++++++++++++---- 2 files changed, 12 insertions(+), 45 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 565c5ee3..9cd3bdc1 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -54,47 +54,6 @@ implementation uses TextGL, UIni, UMain; -{* -//-------------------- -// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist -//-------------------- -procedure InitializePaths; - - // Initialize a Path Variable - // After Setting Paths, make sure that Paths exist - function initialize_path( out aPathVar : String; const aLocation : String ): boolean; - var - lWriteable: Boolean; - begin - aPathVar := aLocation; - - If DirectoryExists(aPathVar) then - lWriteable := ForceDirectories(aPathVar) - else - lWriteable := false; - - if not Writeable then - Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); - - result := lWriteable; - end; - -begin - GamePath := ExtractFilePath(ParamStr(0)); - - initialize_path( LogPath , GamePath ); - initialize_path( SoundPath , GamePath + 'Sounds\' ); - initialize_path( SongPath , GamePath + 'Songs\' ); - initialize_path( ThemePath , GamePath + 'Themes\' ); - initialize_path( ScreenshotsPath , GamePath + 'Screenshots\'); - initialize_path( CoversPath , GamePath + 'Covers\' ); - initialize_path( LanguagesPath , GamePath + 'Languages\' ); - initialize_path( PluginPath , GamePath + 'Plugins\' ); - initialize_path( PlaylistPath , GamePath + 'Playlists\' ); - - DecimalSeparator := ','; -end; -*} //-------------------- // Clears Song Header values diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 9b6ea3d5..66e1d07e 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -748,14 +748,22 @@ procedure InitializePaths; function initialize_path( out aPathVar : String; const aLocation : String ): boolean; var lWriteable: Boolean; + lAttrib : integer; begin - aPathVar := aLocation; + lWriteable := false; + aPathVar := aLocation; + + // Make sure the directory is needex + ForceDirectories(aPathVar); If DirectoryExists(aPathVar) then - lWriteable := ForceDirectories(aPathVar) - else - lWriteable := false; + begin + lAttrib := fileGetAttr('C:Temp'); + lWriteable := ( lAttrib and faDirectory <> 0 ) AND + NOT ( lAttrib and faReadOnly <> 0 ) + end; + if not lWriteable then Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); -- cgit v1.2.3 From 73a9802c1417cc36106f88fe1e6b5989fd47b8b0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 1 Oct 2007 10:41:06 +0000 Subject: added patch (with small modification) which apparently enables USDX to run on linux, using wine. ( currently untested by myself ) BIG THANKS goes to linnex from sourceforge. http://sourceforge.net/forum/message.php?msg_id=4544965 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@454 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 86ce7361..5d599eab 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -264,12 +264,20 @@ begin SetLength(IResolution, 0); Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available repeat -// Log.LogError(Format( ' %d x %d', [ modes^.w, modes^.h ] ) ); SetLength(IResolution, Length(IResolution) + 1); IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); Inc(Modes); until Modes^ = nil; + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + end; + // reverse order for I := 0 to (Length(IResolution) div 2) - 1 do begin S := IResolution[I]; -- cgit v1.2.3 From c21f87b7235114f4d7b5afdc1b097310e36e5129 Mon Sep 17 00:00:00 2001 From: mogguh Date: Mon, 1 Oct 2007 11:05:52 +0000 Subject: SDL_ttf: TextGl.pas - some code for testing (just add printrandomtext(); in ucreditsscreen (ie)) UTextClasses - started to throw everything into classes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@455 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 122 +++++++++++++++++++++++++++++++++++++ Game/Code/Classes/UTextClasses.pas | 57 +++++++++++++++++ 2 files changed, 179 insertions(+) create mode 100644 Game/Code/Classes/UTextClasses.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index c73908f8..3f5d52b8 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -11,6 +11,8 @@ uses OpenGL12, SDL, UTexture, Classes, + dialogs, + SDL_ttf, ULog; procedure BuildFont; // Build Our Bitmap Font @@ -27,6 +29,16 @@ procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) procedure SetFontAspectW(Aspect: real); +// 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; @@ -323,6 +335,7 @@ procedure glPrint(text: pchar); // Custom GL "Print" Routine var // Letter : char; iPos : Integer; + begin if (Text = '') then // If There's No Text Exit; // Do Nothing @@ -350,6 +363,115 @@ begin end; +function NextPowerOfTwo(Value: Integer): Integer; +// tyty to Asphyre +begin + Result:= 1; + asm + xor ecx, ecx + bsr ecx, Value + inc ecx + shl Result, cl + end; +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 ); + 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) / 255); + clr.g := ((Color and $ff00) shr 8)/255; + clr.b := ( Color and $ff)/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, 0, intermediary, 0); + + 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; diff --git a/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas new file mode 100644 index 00000000..5f66d0e8 --- /dev/null +++ b/Game/Code/Classes/UTextClasses.pas @@ -0,0 +1,57 @@ +unit UTextClasses; + +interface +uses OpenGL12, + SDL, + UTexture, + Classes, + dialogs, + 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; + +// 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. -- cgit v1.2.3 From 47128a387be23abfb800909e4662a968c9846397 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 1 Oct 2007 11:31:49 +0000 Subject: fix mogs compile error :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@456 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 3f5d52b8..9b125812 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -392,9 +392,9 @@ function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surf var clr : TSDL_color; begin - clr.r := (((Color and $ff0000) shr 16) / 255); - clr.g := ((Color and $ff00) shr 8)/255; - clr.b := ( Color and $ff)/255; + 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; -- cgit v1.2.3 From b29759fbfdd8a013e3d0a85b578934ebec028c41 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 04:39:22 +0000 Subject: Fixed linux compilation. Linux is now running in the main loop fine. * no audio playback or input yet... * Timing hack inplace.. that must be replace * bunch of textures not working.. however the play screen is looking similar to windows builds. I hope this dosnt break windows builds to much. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@460 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 1108 +++++----- Game/Code/Classes/UCommon.pas | 341 ++-- Game/Code/Classes/UGraphic.pas | 1391 ++++++------- Game/Code/Classes/UIni.pas | 22 +- Game/Code/Classes/ULyrics.pas | 1094 +++++----- Game/Code/Classes/UMain.pas | 1584 ++++++++------- Game/Code/Classes/UMusic.pas | 1473 +++++++------- Game/Code/Classes/USkins.pas | 345 ++-- Game/Code/Classes/UTexture.pas | 2249 ++++++++++---------- Game/Code/Classes/UThemes.pas | 4412 ++++++++++++++++++++-------------------- Game/Code/Classes/UTime.pas | 6 +- 11 files changed, 7079 insertions(+), 6946 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 9b125812..fbe9a050 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,554 +1,554 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses OpenGL12, - SDL, - UTexture, - Classes, - dialogs, - 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); - -// 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; - 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; - -implementation - -uses UMain, - UCommon, - {$IFDEF win32} - windows, - {$ELSE} - lclintf, - lcltype, - {$ENDIF} - SysUtils, - {$IFDEF FPC} - LResources, - {$ENDIF} - UGraphic; - -procedure BuildFont; // Build Our Bitmap Font - - procedure loadfont( aID : integer; aType, aResourceName : String); - {$IFDEF FPC} - var - lLazRes : TLResource; - lResData : TStringStream; - begin - try - lLazRes := LazFindResource( aResourceName, aType ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - lResData.Read(Fonts[ aID ].Width, 256); - finally - freeandnil( lResData ); - end; - end; - - {$ELSE} - var - Rejestr: TResourceStream; - begin - try - Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); - try - Rejestr.Read(Fonts[ aID ].Width, 256); - finally - Rejestr.Free; - end; - {$ENDIF} - - except - Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); - end; - end; - -var - font: HFONT; // Windows Font ID - h_dc: hdc; - Pet: integer; -begin - ActFont := 0; - - Log.LogStatus( '' , '---------------------------'); - - Log.LogStatus( 'Font' , '---------------------------'); - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 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', 'PNG', 'Font', 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', 'PNG', 'Font Outline', 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', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - - - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - -{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Rejestr.Read(Fonts[4].Width, 256); - Rejestr.Free;} - - for Pet := 0 to 255 do - Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; - - for Pet := 0 to 255 do - Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; - - for Pet := 0 to 255 do - Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; - -{ for Pet := 0 to 255 do - Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} - -end; - -procedure KillFont; // Delete The Font -begin -// glDeleteLists(base, 256); // Delete All 96 Characters -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; -begin -// Log.LogStatus(Text, 'glTextWidth'); - Result := 0; - while (length(text) > 0) do begin - Letter := Text[0]; - text := pchar(Copy(text, 2, Length(text)-1)); - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; // while -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; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter -begin - with Fonts[ActFont].Tex do - begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; - // H := 30; - - // 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; - - // 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_COLOR, GL_ONE_MINUS_SRC_COLOR); - 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; - - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with -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_COLOR, GL_ONE_MINUS_SRC_COLOR); - 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; - -procedure glPrint(text: pchar); // Custom GL "Print" Routine -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 -*) - - // 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; - -function NextPowerOfTwo(Value: Integer): Integer; -// tyty to Asphyre -begin - Result:= 1; - asm - xor ecx, ecx - bsr ecx, Value - inc ecx - shl Result, cl - end; -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 ); - 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, 0, intermediary, 0); - - 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; - - -{$IFDEF FPC} -{$IFDEF win32} -initialization - {$I UltraStar.lrs} -{$ENDIF} -{$ENDIF} - - -end. - - +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses OpenGL12, + SDL, + UTexture, + Classes, + dialogs, + 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); + +// 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; + 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; + +implementation + +uses UMain, + UCommon, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + lcltype, + {$ENDIF} + SysUtils, + {$IFDEF FPC} + LResources, + {$ENDIF} + UGraphic; + +procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont( aID : integer; aType, aResourceName : String); + {$IFDEF FPC} + var + lLazRes : TLResource; + lResData : TStringStream; + begin + try + lLazRes := LazFindResource( aResourceName, aType ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + lResData.Read(Fonts[ aID ].Width, 256); + finally + freeandnil( lResData ); + end; + end; + + {$ELSE} + var + Rejestr: TResourceStream; + begin + try + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); + try + Rejestr.Read(Fonts[ aID ].Width, 256); + finally + Rejestr.Free; + end; + {$ENDIF} + + except + Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); + end; + end; + +var + font: HFONT; // Windows Font ID + h_dc: hdc; + Pet: integer; +begin + ActFont := 0; + + Log.LogStatus( '' , '---------------------------'); + + Log.LogStatus( 'Font' , '---------------------------'); + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 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', 'PNG', 'Font', 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', 'PNG', 'Font Outline', 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', 'PNG', 'Font Outline 2', 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', 'BMP', 'Arrow', 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); + +{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[4].Width, 256); + Rejestr.Free;} + + for Pet := 0 to 255 do + Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; + + for Pet := 0 to 255 do + Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; + + for Pet := 0 to 255 do + Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; + +{ for Pet := 0 to 255 do + Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + while (length(text) > 0) do begin + Letter := Text[0]; + text := pchar(Copy(text, 2, Length(text)-1)); + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; // while +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; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + // H := 30; + + // 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; + + // 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_COLOR, GL_ONE_MINUS_SRC_COLOR); + 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; + + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +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_COLOR, GL_ONE_MINUS_SRC_COLOR); + 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; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +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 +*) + + // 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; + +function NextPowerOfTwo(Value: Integer): Integer; +// tyty to Asphyre +begin + Result:= 1; + asm + xor ecx, ecx + bsr ecx, Value + inc ecx + shl Result, cl + end; +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 ); + 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, 0, intermediary, 0); + + 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; + + +{$IFDEF FPC} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + + +end. + + diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 8089f28c..7337751a 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,158 +1,183 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses -{$IFDEF FPC} - lResources, -{$ENDIF} - ULog, -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; - -function LazFindResource( const aName, aType : String ): TLResource; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; - -{$IFDEF Win32} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} - -{$ENDIF} - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -implementation - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -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} - - -{$IFDEF FPC} - -function LazFindResource( const aName, aType : String ): TLResource; -var - iCount : Integer; -begin - result := nil; - - for iCount := 0 to LazarusResources.count -1 do - begin - if ( LazarusResources.items[ iCount ].Name = aName ) AND - ( LazarusResources.items[ iCount ].ValueType = aType ) THEN - begin - result := LazarusResources.items[ iCount ]; - exit; - end; - end; -end; - -function MaxValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result < Data[I] then - Result := Data[I]; -end; - -function MinValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result > Data[I] then - Result := Data[I]; -end; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin -RandomRange := Random(aMax-aMin) + aMin ; -end; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{$IFDEF Win32} -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -{$ENDIF} - -{$ENDIF} - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + SysUtils, +{$IFDEF FPC} + lResources, +{$ENDIF} + ULog, +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function StringReplaceW(text, search, rep: WideString):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + +function LazFindResource( const aName, aType : String ): TLResource; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + +{$IFDEF Win32} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(Wnd: HWND); +{$ENDIF} + +{$ENDIF} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +function StringReplaceW(text, search, rep: WideString):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; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +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} + + +{$IFDEF FPC} + +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; + +function MaxValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result < Data[I] then + Result := Data[I]; +end; + +function MinValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result > Data[I] then + Result := Data[I]; +end; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin +RandomRange := Random(aMax-aMin) + aMin ; +end; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF Win32} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} + +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 44c068a0..5847e41c 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,688 +1,703 @@ -unit UGraphic; - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses - SDL, - OpenGL12, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - - //Notes - Tex_Left: array[0..6] of TTexture; //rename to tex_note_left - Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid - Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - - Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left - Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - - //ScoreBG Texs - Tex_ScoreBG: array [0..5] of TTexture; - -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_SzczytR = 0.8; - Skin_SzczytG = 0; - Skin_SzczytB = 0; - - Skin_SzczytLimitR = 0; - Skin_SzczytLimitG = 0.8; - Skin_SzczytLimitB = 0; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_LyricsT = 494; // 500 / 510 / 400 - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses UMain, - UIni, - UDisplay, - UCommandLine, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - {$IFDEF win32} - windows, - {$ENDIF} - Classes; - -procedure LoadFontTextures; -begin - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure LoadTextures; - - -var - P: integer; - R, G, B: real; - Col: integer; -begin - // zaladowanie tekstur - Log.LogStatus('Loading Textures', 'LoadTextures'); - - Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? - - Log.LogStatus('Loading Textures - A', 'LoadTextures'); - - // P1-6 - // TODO... do it once for each player... this is a bit crappy !! - // can we make it any better !? - for P := 1 to 6 do - begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); - - Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); - Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); - Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); - end; - - Log.LogStatus('Loading Textures - B', 'LoadTextures'); - - Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); - Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); - Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); - //end Singbar Mod - - Log.LogStatus('Loading Textures - C', 'LoadTextures'); - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Case P of - 0: begin - R := 1; - G := 0; - B := 0; - end; - 1..3: begin - R := 1; - G := (P * 0.25); - B := 0; - end; - 4: begin - R := 1; - G := 1; - B := 0; - end; - 5..7: begin - R := 1-((P-4)*0.25); - G := 1; - B := 0; - end; - 8: begin - R := 0; - G := 1; - B := 0; - end; - End; - - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); - end; - - //Score BG Textures - for P := 0 to 5 do begin - LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); - end; - - Log.LogStatus('Loading Textures - D', 'LoadTextures'); -end; - -procedure Initialize3D (Title: string); -var -// Icon: TIcon; -// Res: TResourceStream; - ISurface: PSDL_Surface; - Pixel: PByteArray; - I: Integer; -begin - Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); -// Log.BenchmarkStart(2); - - LoadOpenGL; - - Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then - begin - Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); - exit; - end; - - { //Load Icon - Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); - Icon := TIcon.Create; - Icon.LoadFromStream(Res); - Res.Free; - Icon. - //Create icon Surface - SDL_CreateRGBSurfaceFrom ( - SDL_SWSURFACE, - Icon.Width, - Icon.Height, - 32, - 128 or 64, - 32 or 16, - 8 or 4, - 2 or 1); - //SDL_BlitSurface( - - - SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} - - SDL_WM_SetCaption(PChar(Title), nil); - - InitializeScreen; - -// Log.BenchmarkEnd(2); -// Log.LogBenchmark('--> Setting Screen', 2); - - // ladowanie tekstur -// Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - Texture.Limit := 1024*1024; - -// LoadTextures; -// Log.BenchmarkEnd(2); -// Log.LogBenchmark('--> Loading Textures', 2); - -{ Log.BenchmarkStart(2); - Lyric:= TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); -} - -// Log.BenchmarkStart(2); - Display := TDisplay.Create; - SDL_EnableUnicode(1); -// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - -// Log.LogStatus('Loading Screens', 'Initialize3D'); -// Log.BenchmarkStart(3); - - Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); - LoadFontTextures(); - - // Show the Loading Screen ------------- - Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); - LoadLoadingScreen; - - - Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); - LoadTextures; // jb - - - - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar -// Mutex := SDL_CreateMutex; -// SDL_UnLockMutex(Mutex); - - // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will - // siehe dazu kommentar unten - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // das hier würde dann im ladethread ausgeführt - Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); - LoadScreens; - - - // TODO!!!!!!1 - // hier käme jetzt eine schleife, die - // * den ladescreen malt (ab und zu) - // * den "fortschritt" des ladescreens steuert - // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und - // * die texturen in die opengl lädt, sowie - // * dem ladethread signalisiert, dass der speicher für die textur - // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) - // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, - // dass er alles geladen hat fertig ist - // - // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche - // opengl funktionen aufzurufen, entsprechend mutexe verändert - // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, - // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... - - - //wait for loading thread to finish - // funktioniert so auch noch nicht - //SDL_WaitThread(LoadingThread, I); -// SDL_DestroyMutex(Mutex); - - Display.ActualScreen^.FadeTo( @ScreenMain ); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin -// InitializeScreen; -// LoadTextures; -// LoadScreens; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - {if ParamStr(1) = '-fsblack' then begin - W := 800; - H := 600; - end; - if ParamStr(1) = '-320x240' then begin - W := 320; - H := 240; - end; } - - If (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); - -// Okay it's possible to set the title bar / taskbar icon here -// it's working this way, but just if the bmp is in your exe folder - SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); - -// SDL_SetRefreshrate(85); -// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - if (Ini.FullScreen = 0) and (Not Params.FullScreen) then - begin - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) - end - else - begin - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); - end; - - if (screen = nil) then - begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; - end; - - // clear screen once window is being shown - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; - - // zmienne - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - - Display.ActualScreen := @ScreenLoading; - - swapbuffers; - - ScreenLoading.Draw; - Display.Draw; - - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - ScreenPartyNewRound := TScreenPartyNewRound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); - ScreenPartyScore := TScreenPartyScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - - end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -end. +unit UGraphic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + + //ScoreBG Texs + Tex_ScoreBG: array [0..5] of TTexture; + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + {$IFDEF win32} + windows, + {$ENDIF} + Classes; + +procedure LoadFontTextures; +begin + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + + Log.LogStatus('Loading Textures - A', 'LoadTextures'); + + // P1-6 + // TODO... do it once for each player... this is a bit crappy !! + // can we make it any better !? + for P := 1 to 6 do + begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + end; + + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + Log.LogStatus('Loading Textures - C', 'LoadTextures'); + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Case P of + 0: begin + R := 1; + G := 0; + B := 0; + end; + 1..3: begin + R := 1; + G := (P * 0.25); + B := 0; + end; + 4: begin + R := 1; + G := 1; + B := 0; + end; + 5..7: begin + R := 1-((P-4)*0.25); + G := 1; + B := 0; + end; + 8: begin + R := 0; + G := 1; + B := 0; + end; + End; + + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); + end; + + //Score BG Textures + for P := 0 to 5 do begin + LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); + end; + + Log.LogStatus('Loading Textures - D', 'LoadTextures'); +end; + +procedure Initialize3D (Title: string); +var +// Icon: TIcon; +// Res: TResourceStream; + ISurface: PSDL_Surface; + Pixel: PByteArray; + I: Integer; +begin + Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); +// Log.BenchmarkStart(2); + + LoadOpenGL; + + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then + begin + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); + exit; + end; + + { //Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + Icon. + //Create icon Surface + SDL_CreateRGBSurfaceFrom ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + //SDL_BlitSurface( + + + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} + + SDL_WM_SetCaption(PChar(Title), nil); + + InitializeScreen; + +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur +// Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + +// LoadTextures; +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Loading Textures', 2); + +{ Log.BenchmarkStart(2); + Lyric:= TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); +} + +// Log.BenchmarkStart(2); + + Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); + Display := TDisplay.Create; + + Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D'); + SDL_EnableUnicode(1); +// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + +// Log.LogStatus('Loading Screens', 'Initialize3D'); +// Log.BenchmarkStart(3); + + Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); + LoadFontTextures(); + + // Show the Loading Screen ------------- + Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); + LoadLoadingScreen; + + + Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); + LoadTextures; // jb + + + + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // das hier würde dann im ladethread ausgeführt + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); + LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + + + //wait for loading thread to finish + // funktioniert so auch noch nicht + //SDL_WaitThread(LoadingThread, I); +// SDL_DestroyMutex(Mutex); + + Display.ActualScreen^.FadeTo( @ScreenMain ); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + {if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + + Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon'); + +// Okay it's possible to set the title bar / taskbar icon here +// it's working this way, but just if the bmp is in your exe folder + SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + + {$ifndef win32} + // Todo : jb_linux remove this for linux... but helps for debugging + Ini.FullScreen := 0; + W := 800; + H := 600; + {$endif} + + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) + end + else + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end; + + if (screen = nil) then + begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + + Display.ActualScreen := @ScreenLoading; + + swapbuffers; + + ScreenLoading.Draw; + Display.Draw; + + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + + end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +end. diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 5d599eab..6b7f3cea 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -260,12 +260,22 @@ begin for Pet := 0 to High(IScreens) do if Tekst = IScreens[Pet] then Ini.Screens := Pet; + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + // Resolution SetLength(IResolution, 0); Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available repeat SetLength(IResolution, Length(IResolution) + 1); IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + + Log.LogStatus('SDL_ListModes Res : ' + IResolution[High(IResolution)], 'Graphics - Resolutions'); + Inc(Modes); until Modes^ = nil; @@ -274,8 +284,12 @@ begin // THANKS : linnex at users.sourceforge.net if Length(IResolution) < 1 then begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + Ini.FullScreen := 0; end; // reverse order @@ -289,10 +303,6 @@ begin for Pet := 0 to High(IResolution) do if Tekst = IResolution[Pet] then Ini.Resolution := Pet; - // FullScreen - Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); - for Pet := 0 to High(IFullScreen) do - if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; // Resolution Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 1c2795ce..4fd360b7 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -1,544 +1,550 @@ -unit ULyrics; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, UTexture, UThemes, UMusic; - -type - TLyricWord = record - X: Real; //X Pos of the Word - Width: Real; //Width of the Text - TexPos: Real; //Pos of the Word (0 to 1) in the Sentence Texture - TexWidth: Real; //width of the Word in Sentence Texture (0 to 1) - Start: Cardinal; //Start of the Words in Quarters (Beats) - Length: Cardinal; //Length of the Word in Quarters - Text: String; //Text of this Word - Freestyle: Boolean; //Is this Word Freestyle - end; - ALyricWord = array of TLyricWord; - - PLyricLine = ^TLyricLine; - TLyricLine = record - Text: String; //Text of the Line - Tex: glUInt; //Texture of the Text from this Line - Width: Real; //Width of the Lyricline in Tex - Size: Byte; //Size of the Font in the Texture - Words: ALyricWord; //Words from this Line - Start: Cardinal; //Start in Quarters of teh Line - Length: Cardinal; //Length in Quarters (From Start of First Note to the End of Last Note) - Freestyle: Boolean; //Complete Line is Freestyle ? - Players: Byte; //Which Players Sing this Line (1: Player1; 2: Player2; 4: Player3; [..]) - Done: Boolean; //Is Sentence Sung - end; - - TLyricEngine = class - private - EoLastSentence: Real; //When did the Last Sentence End (in Beats) - UpperLine: TLyricLine; //Line in the Upper Part of the Lyric Display - LowerLine: TLyricLine; //Line in the Lower Part of teh Lyric Display - QueueLine: TLyricLine; //Line that is in Queue and will be added when next Line is Finished - PUpperLine, PLowerLine, PQueueLine: PLyricLine; - - IndicatorTex: TTexture; //Texture for Lyric Indikator(Bar that indicates when the Line start) - BallTex: TTexture; //Texture of the Ball for cur. Word hover in Ballmode - PlayerIconTex: array[0..5] of //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled - array [0..1] of - TTexture; - - inQueue: Boolean; - LCounter: Word; - - //Some helper Procedures for Lyric Drawing - procedure DrawLyrics (Beat: Real); - procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); - procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, 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_akt: TRGBA; //Color of teh active Word - FontStyle: Byte; //Font for the Lyric Text - FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen - - HoverEffekt: Byte; //Effekt of Hovering active Word: 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left - FadeInEffekt: Byte; //Effekt for Line Fading in: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards from Bottom to Pos - FadeOutEffekt: Byte; //Effekt for Line Fading out: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards - - UseLinearFilter:Boolean; //Should Linear Tex Filter be used - - //Song specific Settings - BPM: Real; - Resolution: Integer; - - - //properties to easily update this Class within other Parts of Code - property LineinQueue: Boolean read inQueue; //True when there is a Line in Queue - property LineCounter: Word read LCounter; //Lines that was Progressed so far (after last Clear) - - Constructor Create; overload; //Constructor, just get Memory - Constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); overload; - Procedure LoadTextures; //Load Player Textures and Create - - Procedure AddLine(Line: PLine); //Adds a Line to the Queue if there is Space - Procedure Draw (Beat: Real); //Procedure Draws Lyrics; Beat is curent Beat in Quarters - Procedure Clear (const cBPM: Real = 0; const cResolution: Integer = 0); //Clears all cached Song specific Information - - Destructor Free; //Frees Memory - end; - -const LyricTexStart = 2/512; - -implementation -uses SysUtils, USkins, TextGL, UGraphic, UDisplay, dialogs; - -//----------- -//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: TRGBA); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Color.A); -end; - - - -//--------------- -// Create - Constructor, just get Memory -//--------------- -Constructor TLyricEngine.Create; -begin - 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; -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; - - -//--------------- -// Free - Frees Memory -//--------------- -Destructor TLyricEngine.Free; -begin - -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; -end; - - -//--------------- -// LoadTextures - Load Player Textures and Create Lyric Textures -//--------------- -Procedure TLyricEngine.LoadTextures; -var - I: Integer; - PTexData: Pointer; - - function CreateLineTex: glUint; - begin - GetMem(pTexData, 1024*128*4); //get Memory to save Tex in - - //generate and bind Texture - glGenTextures(1, Result); - glBindTexture(GL_TEXTURE_2D, Result); - - //Get Memory - glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); - - 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; - - //Free now unused Memory - FreeMem(pTexData); - end; -begin - //Load Texture for Lyric Indikator(Bar that indicates when the Line start) - IndicatorTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - - //Load Texture of the Ball for cur. Word hover in Ballmode - BallTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - - //Load PlayerTexs - For I := 0 to 1 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - end; - - //atm just unset other texs - For I := 2 to 5 do - begin - PlayerIconTex[I][0].TexNum := high(Cardinal); //Set to C's -1 - PlayerIconTex[I][1].TexNum := high(Cardinal); - end; - - //Create LineTexs - UpperLine.Tex := CreateLineTex; - LowerLine.Tex := CreateLineTex; - QueueLine.Tex := CreateLineTex; -end; - - -//--------------- -// AddLine - Adds LyricLine to queue -//--------------- -Procedure TLyricEngine.AddLine(Line: PLine); -var - LyricLine: PLyricLine; - I: Integer; - countNotes: Cardinal; - PosX: Real; - Viewport: Array[0..3] of Integer; -begin - //Only Add Lines if there is enough space - If not LineinQueue then - begin - //Set Pointer to Line to Write - If (LineCounter = 0) then - LyricLine := PUpperLine //Set Upper Line - else if (LineCounter = 1) then - LyricLine := PLowerLine //Set Lower Line - else - begin - LyricLine := PQueueLine; //Set Queue Line - inQueue := True; //now there is a Queued Line - end; - end - else - begin - LyricLine:=PUpperLine; - PUpperLine:=PLowerLine; - PLowerLine:=PQueueLine; - PQueueLine:=LyricLine; - end; - - //Check if Sentence has Notes - If (Length(Line.Nuta) > 0) then - begin - //Copy Values from SongLine to LyricLine - CountNotes := high(Line.Nuta); - LyricLine.Start := Line.Nuta[0].Start; - LyricLine.Length := Line.Nuta[CountNotes].Start + Line.Nuta[CountNotes].Dlugosc - LyricLine.Start; - LyricLine.Freestyle := True; //is set by And Notes Freestyle while copying Notes - LyricLine.Text := ''; //Also Set while copying Notes - LyricLine.Players := 127; //All Players for now, no Duett Mode available - //Copy Words - SetLength(LyricLine.Words, CountNotes + 1); - For I := 0 to CountNotes do - begin - LyricLine.Freestyle := LyricLine.Freestyle AND Line.Nuta[I].FreeStyle; - LyricLine.Words[I].Start := Line.Nuta[I].Start; - LyricLine.Words[I].Length := Line.Nuta[I].Dlugosc; - LyricLine.Words[I].Text := Line.Nuta[I].Tekst; - LyricLine.Words[I].Freestyle := Line.Nuta[I].FreeStyle; - LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text - 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 - While (LyricLine.Width > 508) do - begin - Dec(LyricLine.Size); - - if (LyricLine.Size <=1) then - Break; - - SetFontSize(LyricLine.Size); - LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); - end; - - //Set Word Positions and Line Size - PosX := 2 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; - For I := 0 to High(LyricLine.Words) do - begin - LyricLine.Words[I].X := PosX; - LyricLine.Words[I].Width := glTextWidth(PChar(LyricLine.Words[I].Text)); - LyricLine.Words[I].TexPos := PosX / 512; - LyricLine.Words[I].TexWidth := LyricLine.Words[I].TexWidth / 512; - - PosX := PosX + LyricLine.Words[I].Width; - end; - - //Create LyricTexture - //Prepare Ogl - glGetIntegerv(GL_VIEWPORT, @ViewPort); - glClearColor(0.0,0.0,0.0,0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - {glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, 1024, 64, 0, -1, 100); - glMatrixMode(GL_MODELVIEW);} - glViewport(0, 0, 512, 512); - - //Draw Lyrics - SetFontPos(0, 0); - glPrint(PChar(LyricLine.Text)); - - Display.ScreenShot; - //Copy to Texture - glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 448, 512, 64, 0); - - //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]); - {glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); } - end; - - //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); - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_Alpha {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_Alpha); - glBindTexture(GL_TEXTURE_2D, PUpperLine^.Tex); - - glColor4f(1,1,0,1); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(100, 100); - glTexCoord2f(0, 0); glVertex2f(100, 200); - glTexCoord2f(1, 0); glVertex2f(612, 200); - glTexCoord2f(1, 1); glVertex2f(612, 100); - glEnd; - - glBindTexture(GL_TEXTURE_2D, PLowerLine^.Tex); - - glColor4f(1,0,1,1); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(100, 200); - glTexCoord2f(0, 0); glVertex2f(100, 300); - glTexCoord2f(1, 0); glVertex2f(612, 300); - glTexCoord2f(1, 1); glVertex2f(612, 200); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - -end; - -//--------------- -// DrawLyrics(private) - Helper for Draw; main Drawing procedure -//--------------- -procedure TLyricEngine.DrawLyrics (Beat: Real); -begin - DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); -end; - -//--------------- -// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon -//--------------- -procedure TLyricEngine.DrawPlayerIcon(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; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); - - glColor4f(1,1,1,Alpha); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y + Size); - glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); - glTexCoord2f(1, 0); glVertex2f(X + Size, Y); - glEnd; - - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; -//--------------- -// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine -//--------------- -procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); -var - I: Integer; - CurWord: Integer; - Progress: Real; - LyricX: Real; //Left Corner on X Axis - LyricX2: Real;//Right Corner " " - LyricScale: Real; //Up or Downscale the Lyrics need - IconSize: Real; - IconAlpha: Real; -begin - -{ For I := 0 to High(Line.Words) do - begin - //Set Font Params - SetFontStyle(FontStyle); - SetFontSize(Size); - SetFontItalic(Line.Words[I].Freestyle); - glColor4f(1, 1, 1, 1); - - SetFontPos(Line.Words[I].X, Y); - - glPrint(PChar(Line.Words[I].Text)); - end; } - - LyricScale := Size / Line.Size; - - //Draw Icons - IconSize := (2 * Size); - //IconAlpha := 1; - IconAlpha := Frac(Beat/(Resolution*4)); - - {DrawPlayerIcon (0, True, X, Y, IconSize, IconAlpha); - DrawPlayerIcon (1, True, X + IconSize + 1, Y, IconSize, IconAlpha); - DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} - - //Check if a Word in the Sentence is active - if ((Line.Start > Beat) AND (Line.Start + Line.Length < Beat)) then - begin - //Get Start Position: - { Start of Line - Width of all Icons + LineWidth/2 (Center} - LyricX := X + (W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3); - - LyricX2 := LyricX + Line.Width; - - //Draw complete Sentence - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_COLOR); - glBindTexture(GL_TEXTURE_2D, Line.Tex); - - glColorRGB(LineColor_en); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(LyricX, Y); - glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); - glTexCoord2f(1, 0); glVertex2f(LyricX + LyricX2, Y + 64 * W / 512); - glTexCoord2f(1, 1); glVertex2f(LyricX + LyricX2, Y); - glEnd; - - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end - else - begin - - end; - - {//Search for active Word - For I := 0 to High(Line.Words) do - if (Line.Words[I].Start < Beat) then - begin - CurWord := I - 1; - end; - - if (CurWord < 0) then Exit; - - //Draw Part until cur Word - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}{, GL_ONE_MINUS_SRC_COLOR); - glBindTexture(GL_TEXTURE_2D, Line.Tex); - - glColorRGB(LineColor_en); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(X, Y); - glTexCoord2f(0, 0); glVertex2f(X, Y + 64 * W / 512); - glTexCoord2f(Line.Words[CurWord].TexPos, 0); glVertex2f(X + W, Y + 64 * W / 512); - glTexCoord2f(Line.Words[CurWord].TexPos, 1); glVertex2f(X + W, Y); - glEnd; - - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D);} -end; - - -end. - +unit ULyrics; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, UTexture, UThemes, UMusic; + +type + TLyricWord = record + X: Real; //X Pos of the Word + Width: Real; //Width of the Text + TexPos: Real; //Pos of the Word (0 to 1) in the Sentence Texture + TexWidth: Real; //width of the Word in Sentence Texture (0 to 1) + Start: Cardinal; //Start of the Words in Quarters (Beats) + Length: Cardinal; //Length of the Word in Quarters + Text: String; //Text of this Word + Freestyle: Boolean; //Is this Word Freestyle + end; + ALyricWord = array of TLyricWord; + + PLyricLine = ^TLyricLine; + TLyricLine = record + Text: String; //Text of the Line + Tex: glUInt; //Texture of the Text from this Line + Width: Real; //Width of the Lyricline in Tex + Size: Byte; //Size of the Font in the Texture + Words: ALyricWord; //Words from this Line + Start: Cardinal; //Start in Quarters of teh Line + Length: Cardinal; //Length in Quarters (From Start of First Note to the End of Last Note) + Freestyle: Boolean; //Complete Line is Freestyle ? + Players: Byte; //Which Players Sing this Line (1: Player1; 2: Player2; 4: Player3; [..]) + Done: Boolean; //Is Sentence Sung + end; + + TLyricEngine = class + private + EoLastSentence: Real; //When did the Last Sentence End (in Beats) + UpperLine: TLyricLine; //Line in the Upper Part of the Lyric Display + LowerLine: TLyricLine; //Line in the Lower Part of teh Lyric Display + QueueLine: TLyricLine; //Line that is in Queue and will be added when next Line is Finished + PUpperLine, PLowerLine, PQueueLine: PLyricLine; + + IndicatorTex: TTexture; //Texture for Lyric Indikator(Bar that indicates when the Line start) + BallTex: TTexture; //Texture of the Ball for cur. Word hover in Ballmode + PlayerIconTex: array[0..5] of //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + array [0..1] of + TTexture; + + inQueue: Boolean; + LCounter: Word; + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); + procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, 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_akt: TRGBA; //Color of teh active Word + FontStyle: Byte; //Font for the Lyric Text + FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen + + HoverEffekt: Byte; //Effekt of Hovering active Word: 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FadeInEffekt: Byte; //Effekt for Line Fading in: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards from Bottom to Pos + FadeOutEffekt: Byte; //Effekt for Line Fading out: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards + + UseLinearFilter:Boolean; //Should Linear Tex Filter be used + + //Song specific Settings + BPM: Real; + Resolution: Integer; + + + //properties to easily update this Class within other Parts of Code + property LineinQueue: Boolean read inQueue; //True when there is a Line in Queue + property LineCounter: Word read LCounter; //Lines that was Progressed so far (after last Clear) + + Constructor Create; overload; //Constructor, just get Memory + Constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); overload; + Procedure LoadTextures; //Load Player Textures and Create + + Procedure AddLine(Line: PLine); //Adds a Line to the Queue if there is Space + Procedure Draw (Beat: Real); //Procedure Draws Lyrics; Beat is curent Beat in Quarters + Procedure Clear (const cBPM: Real = 0; const cResolution: Integer = 0); //Clears all cached Song specific Information + + Destructor Free; //Frees Memory + end; + +const LyricTexStart = 2/512; + +implementation + +uses SysUtils, + USkins, + TextGL, + UGraphic, + UDisplay, + dialogs; + +//----------- +//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: TRGBA); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Color.A); +end; + + + +//--------------- +// Create - Constructor, just get Memory +//--------------- +Constructor TLyricEngine.Create; +begin + 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; +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; + + +//--------------- +// Free - Frees Memory +//--------------- +Destructor TLyricEngine.Free; +begin + +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; +end; + + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +Procedure TLyricEngine.LoadTextures; +var + I: Integer; + PTexData: Pointer; + + function CreateLineTex: glUint; + begin + GetMem(pTexData, 1024*128*4); //get Memory to save Tex in + + //generate and bind Texture + glGenTextures(1, @Result); + glBindTexture(GL_TEXTURE_2D, Result); + + //Get Memory + glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); + + 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; + + //Free now unused Memory + FreeMem(pTexData); + end; +begin + //Load Texture for Lyric Indikator(Bar that indicates when the Line start) + IndicatorTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + //Load Texture of the Ball for cur. Word hover in Ballmode + BallTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + + //Load PlayerTexs + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + + //atm just unset other texs + For I := 2 to 5 do + begin + PlayerIconTex[I][0].TexNum := high(Cardinal); //Set to C's -1 + PlayerIconTex[I][1].TexNum := high(Cardinal); + end; + + //Create LineTexs + UpperLine.Tex := CreateLineTex; + LowerLine.Tex := CreateLineTex; + QueueLine.Tex := CreateLineTex; +end; + + +//--------------- +// AddLine - Adds LyricLine to queue +//--------------- +Procedure TLyricEngine.AddLine(Line: PLine); +var + LyricLine: PLyricLine; + I: Integer; + countNotes: Cardinal; + PosX: Real; + Viewport: Array[0..3] of Integer; +begin + //Only Add Lines if there is enough space + If not LineinQueue then + begin + //Set Pointer to Line to Write + If (LineCounter = 0) then + LyricLine := PUpperLine //Set Upper Line + else if (LineCounter = 1) then + LyricLine := PLowerLine //Set Lower Line + else + begin + LyricLine := PQueueLine; //Set Queue Line + inQueue := True; //now there is a Queued Line + end; + end + else + begin + LyricLine:=PUpperLine; + PUpperLine:=PLowerLine; + PLowerLine:=PQueueLine; + PQueueLine:=LyricLine; + end; + + //Check if Sentence has Notes + If (Length(Line.Nuta) > 0) then + begin + //Copy Values from SongLine to LyricLine + CountNotes := high(Line.Nuta); + LyricLine.Start := Line.Nuta[0].Start; + LyricLine.Length := Line.Nuta[CountNotes].Start + Line.Nuta[CountNotes].Dlugosc - LyricLine.Start; + LyricLine.Freestyle := True; //is set by And Notes Freestyle while copying Notes + LyricLine.Text := ''; //Also Set while copying Notes + LyricLine.Players := 127; //All Players for now, no Duett Mode available + //Copy Words + SetLength(LyricLine.Words, CountNotes + 1); + For I := 0 to CountNotes do + begin + LyricLine.Freestyle := LyricLine.Freestyle AND Line.Nuta[I].FreeStyle; + LyricLine.Words[I].Start := Line.Nuta[I].Start; + LyricLine.Words[I].Length := Line.Nuta[I].Dlugosc; + LyricLine.Words[I].Text := Line.Nuta[I].Tekst; + LyricLine.Words[I].Freestyle := Line.Nuta[I].FreeStyle; + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text + 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 + While (LyricLine.Width > 508) do + begin + Dec(LyricLine.Size); + + if (LyricLine.Size <=1) then + Break; + + SetFontSize(LyricLine.Size); + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + end; + + //Set Word Positions and Line Size + PosX := 2 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; + For I := 0 to High(LyricLine.Words) do + begin + LyricLine.Words[I].X := PosX; + LyricLine.Words[I].Width := glTextWidth(PChar(LyricLine.Words[I].Text)); + LyricLine.Words[I].TexPos := PosX / 512; + LyricLine.Words[I].TexWidth := LyricLine.Words[I].TexWidth / 512; + + PosX := PosX + LyricLine.Words[I].Width; + end; + + //Create LyricTexture + //Prepare Ogl + glGetIntegerv(GL_VIEWPORT, @ViewPort); + glClearColor(0.0,0.0,0.0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + {glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, 1024, 64, 0, -1, 100); + glMatrixMode(GL_MODELVIEW);} + glViewport(0, 0, 512, 512); + + //Draw Lyrics + SetFontPos(0, 0); + glPrint(PChar(LyricLine.Text)); + + Display.ScreenShot; + //Copy to Texture + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 448, 512, 64, 0); + + //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]); + {glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); } + end; + + //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); + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_Alpha {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_Alpha); + glBindTexture(GL_TEXTURE_2D, PUpperLine^.Tex); + + glColor4f(1,1,0,1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(100, 100); + glTexCoord2f(0, 0); glVertex2f(100, 200); + glTexCoord2f(1, 0); glVertex2f(612, 200); + glTexCoord2f(1, 1); glVertex2f(612, 100); + glEnd; + + glBindTexture(GL_TEXTURE_2D, PLowerLine^.Tex); + + glColor4f(1,0,1,1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(100, 200); + glTexCoord2f(0, 0); glVertex2f(100, 300); + glTexCoord2f(1, 0); glVertex2f(612, 300); + glTexCoord2f(1, 1); glVertex2f(612, 200); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + +end; + +//--------------- +// DrawLyrics(private) - Helper for Draw; main Drawing procedure +//--------------- +procedure TLyricEngine.DrawLyrics (Beat: Real); +begin + DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); +end; + +//--------------- +// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon +//--------------- +procedure TLyricEngine.DrawPlayerIcon(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; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); + + glColor4f(1,1,1,Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y + Size); + glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); + glTexCoord2f(1, 0); glVertex2f(X + Size, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); +var + I: Integer; + CurWord: Integer; + Progress: Real; + LyricX: Real; //Left Corner on X Axis + LyricX2: Real;//Right Corner " " + LyricScale: Real; //Up or Downscale the Lyrics need + IconSize: Real; + IconAlpha: Real; +begin + +{ For I := 0 to High(Line.Words) do + begin + //Set Font Params + SetFontStyle(FontStyle); + SetFontSize(Size); + SetFontItalic(Line.Words[I].Freestyle); + glColor4f(1, 1, 1, 1); + + SetFontPos(Line.Words[I].X, Y); + + glPrint(PChar(Line.Words[I].Text)); + end; } + + LyricScale := Size / Line.Size; + + //Draw Icons + IconSize := (2 * Size); + //IconAlpha := 1; + IconAlpha := Frac(Beat/(Resolution*4)); + + {DrawPlayerIcon (0, True, X, Y, IconSize, IconAlpha); + DrawPlayerIcon (1, True, X + IconSize + 1, Y, IconSize, IconAlpha); + DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} + + //Check if a Word in the Sentence is active + if ((Line.Start > Beat) AND (Line.Start + Line.Length < Beat)) then + begin + //Get Start Position: + { Start of Line - Width of all Icons + LineWidth/2 (Center} + LyricX := X + (W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3); + + LyricX2 := LyricX + Line.Width; + + //Draw complete Sentence + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_COLOR); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); + glTexCoord2f(1, 0); glVertex2f(LyricX + LyricX2, Y + 64 * W / 512); + glTexCoord2f(1, 1); glVertex2f(LyricX + LyricX2, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end + else + begin + + end; + + {//Search for active Word + For I := 0 to High(Line.Words) do + if (Line.Words[I].Start < Beat) then + begin + CurWord := I - 1; + end; + + if (CurWord < 0) then Exit; + + //Draw Part until cur Word + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}{, GL_ONE_MINUS_SRC_COLOR); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(X, Y); + glTexCoord2f(0, 0); glVertex2f(X, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 0); glVertex2f(X + W, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 1); glVertex2f(X + W, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D);} +end; + + +end. + diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 66e1d07e..aa4bc639 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,791 +1,793 @@ -unit UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - UGraphic, - UMusic, - URecord, - UTime, - SysUtils, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - OpenGL12, - {$IFDEF UseSerialPort} - zlportio {you can disable it and all PortWriteB calls}, - {$ENDIF} - ULCD, - ULight, - UThemes; - -type - TPlayer = record - Name: string; - - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreI: integer; - ScoreLineI: integer; - ScoreGoldenI: integer; - ScoreTotalI: integer; - - - - //LineBonus Mod - ScoreLast: Real;//Last Line Score - {ScorePercent: integer;//Aktual Fillstate of the SingBar - ScorePercentTarget: integer;//Target Fillstate of the SingBar - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: Single; - LineBonus_PosY: Single; - LineBonus_Alpha: Single; - LineBonus_Visible: boolean; - LineBonus_Text: string; - LineBonus_Color: TRGB; - LineBonus_Age: Integer; - LineBonus_Rating: Integer; - //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes - LineBonus_TargetX: integer; - LineBonus_TargetY: integer; - LineBonus_StartX: integer; - LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End } - - - //PerfectLineTwinkle Mod (effect) - LastSentencePerfect: Boolean; - //PerfectLineTwinkle Mod end - - -// Meter: real; - - HighNut: integer; - IlNut: integer; - Nuta: array of record - Start: integer; - Dlugosc: integer; - Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute - Ton: real; - Perfect: boolean; // true if the note matches the original one, lit the star - - - - // Half size Notes Patch - Hit: boolean; // true if the note Hits the Line - //end Half size Notes Patch - - - - end; - end; - - -var - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; - - OGL: Boolean; - Done: Boolean; - Event: TSDL_event; - FileName: string; - Restart: boolean; - - // gracz i jego nuty - Player: array of TPlayer; - PlayersPlay: integer; - -procedure InitializePaths; - -procedure MainLoop; -procedure CheckEvents; -procedure Sing(Sender: TScreenSing); -procedure NewSentence(Sender: TScreenSing); -procedure NewBeat(Sender: TScreenSing); // executed when on then new beat -procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click -procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection -//procedure NewHalf; // executed when in the half between beats -procedure NewNote(Sender: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - -implementation -uses USongs, UJoystick, math, UCommandLine; - -procedure MainLoop; -var - Delay: integer; -begin - SDL_EnableKeyRepeat(125, 125); - While not Done do - Begin - // joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - done := not Display.Draw; - SwapBuffers; - - // light - Light.Refresh; - - // delay - CountMidTime; -// if 1000*TimeMid > 100 then beep; - Delay := Floor(1000 / 100 - 1000 * TimeMid); - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - CountSkipTime; - - // reinitialization of graphics - if Restart then begin - Reinitialize3D; - Restart := false; - end; - - End; - UnloadOpenGL; -End; - -Procedure CheckEvents; -//var -// p: pointer; -Begin - if not Assigned(Display.NextScreen) then - While SDL_PollEvent( @event ) = 1 Do - Begin -// beep; - Case Event.type_ Of - SDL_QUITEV: begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; -{ SDL_MOUSEBUTTONDOWN: - With Event.button Do - Begin - If State = SDL_BUTTON_LEFT Then - Begin - // - End; - End; // With} - SDL_KEYDOWN: - begin - //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path - if (Event.key.keysym.sym = SDLK_SYSREQ) then - Display.ScreenShot - - // popup hack... if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - // end of popup hack - - else - begin - // check for Screen want to Exit - done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); - - //If Screen wants to Exit - if done then - begin - //If Question Option is enabled then Show Exit Popup - if (Ini.AskbeforeDel = 1) then - begin - Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); - end - else //When asking for exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - end; - - end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then - end; -// SDL_JOYAXISMOTION: -// begin -// beep -// end; - SDL_JOYBUTTONDOWN: - begin - beep - end; - End; // Case Event.type_ - End; // While -End; // CheckEvents - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(AktSong.BPM) = BPMNum then begin - // last BPM - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end else begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then begin - // there is still remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end else begin - // there is no remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -// TopBeat: real; -// TempBeat: real; -// TempTime: real; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; - - (* 2 BPMs *) -{ if Length(AktSong.BPM) > 1 then begin - (* new system *) - CurBeat := 0; - TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); - if TopBeat > AktSong.BPM[1].StartBeat then begin - // analyze second BPM - Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); - CurBeat := AktSong.BPM[1].StartBeat; - TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); - Result := CurBeat + TopBeat; - - end else begin - (* pierwszy przedzial *) - Result := TopBeat; - end; - end; // if} - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end; // if -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - Result := 0; - if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; - - (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - Result := AktSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin - if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin - // full range - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin - // in the middle - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - -{ while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end;} - end; // if} -end; - -procedure Sing(Sender: TScreenSing); -var - Pet: integer; - PetGr: integer; - CP: integer; - Done: real; - N: integer; -begin - Czas.Teraz := Czas.Teraz + TimeSkip; - - Czas.OldBeat := Czas.AktBeat; - Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function - Czas.AktBeat := Floor(Czas.MidBeat); - -// Czas.OldHalf := Czas.AktHalf; -// Czas.MidHalf := Czas.MidBeat + 0.5; -// Czas.AktHalf := Floor(Czas.MidHalf); - - Czas.OldBeatC := Czas.AktBeatC; - Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); - Czas.AktBeatC := Floor(Czas.MidBeatC); - - Czas.OldBeatD := Czas.AktBeatD; - Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP - Czas.AktBeatD := Floor(Czas.MidBeatD); - Czas.FracBeatD := Frac(Czas.MidBeatD); - - // sentences routines - for PetGr := 0 to 0 do begin;//High(Gracz) do begin - CP := PetGr; - // ustawianie starej czesci - Czas.OldCzesc := Czesci[CP].Akt; - - // wybieranie aktualnej czesci - for Pet := 0 to Czesci[CP].High do - if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; - - // czysczenie nut gracza, gdy to jest nowa plansza - // (optymizacja raz na halfbeat jest zla) - if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); - - end; // for PetGr - - // wykonuje operacje raz na beat - if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then - NewBeat(Sender); - - // make some operations on clicks - if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then - NewBeatC(Sender); - - // make some operations when detecting new voice pitch - if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then - NewBeatD(Sender); - - // wykonuje operacje w polowie beatu -// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then -// NewHalf; - - // plynnie przesuwa text - Done := 1; - for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) - and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then - Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); - - N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; - - // wylacza ostatnia nute po przejsciu - {// todo: Lyrics - if (Ini.LyricsEffect = 1) and (Done = 1) and - (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) - then Sender.LyricMain.Selected := -1; - - if Done > 1 then Done := 1; - Sender.LyricMain.Done := Done; } - - // use Done with LCD -{ with ScreenSing do begin - if LyricMain.Selected >= 0 then begin - LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); - LCD.ShowCursor; - end; - end;} - - -end; - -procedure NewSentence(Sender: TScreenSing); -var -G: Integer; -begin - // czyszczenie nut graczy - for G := 0 to High(Player) do begin - Player[G].IlNut := 0; - Player[G].HighNut := -1; - SetLength(Player[G].Nuta, 0); - end; - - // Add Words to Lyrics - with Sender do begin - {LyricMain.AddCzesc(Czesci[0].Akt); - if Czesci[0].Akt < Czesci[0].High then - LyricSub.AddCzesc(Czesci[0].Akt+1) - else - LyricSub.Clear;} - while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do - Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]); - end; - - Sender.UpdateLCD; - - //On Sentence Change... - Sender.onSentenceChange(Czesci[0].Akt); -end; - -procedure NewBeat(Sender: TScreenSing); -var - Pet: integer; -// TempBeat: integer; -begin - // ustawia zaznaczenie tekstu -// SingScreen.LyricMain.Selected := -1; - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin - // operates on currently beated note - //Todo: Lyrics - //Sender.LyricMain.Selected := Pet; - -// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); -// LCD.ShowCursor; - - //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); - LCD.ShowCursor; - - end; -end; - -procedure NewBeatC; -var - Pet: integer; -// LPT_1: integer; -// LPT_2: integer; -begin -// LPT_1 := 1; -// LPT_2 := 1; - - // beat click - if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - Music.PlayClick; - - // debug system on LPT - if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin - //LPT_1 := 0; -// Light.LightOne(0, 150); - - Light.LightOne(1, 200); // beat light - if ParamStr(1) = '-doublelights' then - Light.LightOne(0, 200); // beat light - - -{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then - Light.LightOne(0, 150) - else - Light.LightOne(1, 150)} - end; - - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin - // click assist - if Ini.ClickAssist = 1 then - Music.PlayClick; - - //LPT_2 := 0; - if ParamStr(1) <> '-doublelights' then - Light.LightOne(0, 150); //125 - - - // drum machine -(* TempBeat := Czas.AktBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; -// if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) - end; - - {$IFDEF UseSerialPort} - // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala - {$ENDIF} -end; - -procedure NewBeatD(Sender: TScreenSing); -begin - NewNote(Sender); -end; - -//procedure NewHalf; -//begin -// NewNote; -//end; - -procedure NewNote(Sender: TScreenSing); -var - CP: integer; // current player - S: integer; // sentence - SMin: integer; - SMax: integer; - SDet: integer; // temporary: sentence of detected note - Pet: integer; - Mozna: boolean; - Nowa: boolean; - Range: integer; - NoteHit:boolean; -begin -// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); -// beep; - - // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) - // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do begin - - // analyze buffer - Sound[CP].AnalizujBufor; - - // adds some noise -// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; - - // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SMin := Czesci[0].Akt-1; - if SMin < 0 then SMin := 0; - SMax := Czesci[0].Akt; - - // check if we can add new note - Mozna := false; - SDet:=SMin; - for S := SMin to SMax do - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) - and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 - then begin - SDet := S; - Mozna := true; - Break; - end; - - S := SDet; - - - - - -// Czas.SzczytJest := true; -// Czas.Ton := 27; - - // gdy moze, to dodaje nute - if (Sound[CP].SzczytJest) and (Mozna) then begin - // operowanie na ostatniej nucie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + - Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin - // to robi, tylko dla pary nut (oryginalnej i gracza) - - // przesuwanie tonu w odpowiednia game - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - Sound[CP].Ton := Sound[CP].Ton - 12; - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - Sound[CP].Ton := Sound[CP].Ton + 12; - - // Half size Notes Patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin - Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; - - - // Half size Notes Patch - NoteHit := true; - - - if (Ini.LineBonus = 0) then - begin - // add points without LineBonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end - else - begin - // add points with Line Bonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end; - - Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; - Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; - - Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; - end; - - end; // operowanie - - // sprawdzanie czy to nowa nuta, czy przedluzenie - if S = SMax then begin - Nowa := true; - // jezeli ostatnia ma ten sam ton - if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) - and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) - then Nowa := false; - // jezeli jest jakas nowa nuta na sprawdzanym beacie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then - Nowa := true; - - // dodawanie nowej nuty - if Nowa then begin - // nowa nuta - Player[CP].IlNut := Player[CP].IlNut + 1; - Player[CP].HighNut := Player[CP].HighNut + 1; - SetLength(Player[CP].Nuta, Player[CP].IlNut); - Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl - Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; - - - // Half Note Patch - Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; - - - // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); - - end else begin - // przedluzenie nuty - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; - end; - - - // check for perfect note and then lit the star (on Draw) - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) - and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin - Player[CP].Nuta[Player[CP].HighNut].Perfect := true; - end; - - end;// else beep; // if S = SMax - - end; // if moze - end; // for CP -// Log.LogStatus('EndBeat', 'NewBeat'); - -//On Sentence End -> For LineBonus + SingBar -if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then -if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then - Sender.onSentenceEnd(sDet); - -end; - -procedure ClearScores(PlayerNum: integer); -begin - Player[PlayerNum].Score := 0; - Player[PlayerNum].ScoreI := 0; - Player[PlayerNum].ScoreLine := 0; - Player[PlayerNum].ScoreLineI := 0; - Player[PlayerNum].ScoreGolden := 0; - Player[PlayerNum].ScoreGoldenI := 0; - Player[PlayerNum].ScoreTotalI := 0; -end; - -//-------------------- -// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist -//-------------------- -procedure InitializePaths; - - // Initialize a Path Variable - // After Setting Paths, make sure that Paths exist - function initialize_path( out aPathVar : String; const aLocation : String ): boolean; - var - lWriteable: Boolean; - lAttrib : integer; - begin - lWriteable := false; - aPathVar := aLocation; - - // Make sure the directory is needex - ForceDirectories(aPathVar); - - If DirectoryExists(aPathVar) then - begin - lAttrib := fileGetAttr('C:Temp'); - - lWriteable := ( lAttrib and faDirectory <> 0 ) AND - NOT ( lAttrib and faReadOnly <> 0 ) - end; - - if not lWriteable then - Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); - - result := lWriteable; - end; - -begin - - GamePath := ExtractFilePath(ParamStr(0)); - - initialize_path( LogPath , GamePath ); - initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); - initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); - initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); - initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); - initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); - initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); - initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); - initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); - - DecimalSeparator := ','; -end; - -end. - +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphic, + UMusic, + URecord, + UTime, + SysUtils, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + OpenGL12, + {$IFDEF UseSerialPort} + zlportio {you can disable it and all PortWriteB calls}, + {$ENDIF} + ULCD, + ULight, + UThemes; + +type + TPlayer = record + Name: string; + + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreI: integer; + ScoreLineI: integer; + ScoreGoldenI: integer; + ScoreTotalI: integer; + + + + //LineBonus Mod + ScoreLast: Real;//Last Line Score + {ScorePercent: integer;//Aktual Fillstate of the SingBar + ScorePercentTarget: integer;//Target Fillstate of the SingBar + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + LineBonus_PosX: Single; + LineBonus_PosY: Single; + LineBonus_Alpha: Single; + LineBonus_Visible: boolean; + LineBonus_Text: string; + LineBonus_Color: TRGB; + LineBonus_Age: Integer; + LineBonus_Rating: Integer; + //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes + LineBonus_TargetX: integer; + LineBonus_TargetY: integer; + LineBonus_StartX: integer; + LineBonus_StartY: integer; + //PhrasenBonus - Line Bonus Mod End } + + + //PerfectLineTwinkle Mod (effect) + LastSentencePerfect: Boolean; + //PerfectLineTwinkle Mod end + + +// Meter: real; + + HighNut: integer; + IlNut: integer; + Nuta: array of record + Start: integer; + Dlugosc: integer; + Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute + Ton: real; + Perfect: boolean; // true if the note matches the original one, lit the star + + + + // Half size Notes Patch + Hit: boolean; // true if the note Hits the Line + //end Half size Notes Patch + + + + end; + end; + + +var + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; + + OGL: Boolean; + Done: Boolean; + Event: TSDL_event; + FileName: string; + Restart: boolean; + + // gracz i jego nuty + Player: array of TPlayer; + PlayersPlay: integer; + +procedure InitializePaths; + +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Sender: TScreenSing); +procedure NewSentence(Sender: TScreenSing); +procedure NewBeat(Sender: TScreenSing); // executed when on then new beat +procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click +procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection +//procedure NewHalf; // executed when in the half between beats +procedure NewNote(Sender: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation +uses USongs, UJoystick, math, UCommandLine; + +procedure MainLoop; +var + Delay: integer; +begin + SDL_EnableKeyRepeat(125, 125); + While not Done do + Begin + // joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // light + Light.Refresh; + + // delay + CountMidTime; +// if 1000*TimeMid > 100 then beep; + Delay := Floor(1000 / 100 - 1000 * TimeMid); + + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + + CountSkipTime; + + // reinitialization of graphics + if Restart then begin + Reinitialize3D; + Restart := false; + end; + + End; + UnloadOpenGL; +End; + +Procedure CheckEvents; +//var +// p: pointer; +Begin + if not Assigned(Display.NextScreen) then + While SDL_PollEvent( @event ) = 1 Do + Begin +// beep; + Case Event.type_ Of + SDL_QUITEV: begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; +{ SDL_MOUSEBUTTONDOWN: + With Event.button Do + Begin + If State = SDL_BUTTON_LEFT Then + Begin + // + End; + End; // With} + SDL_KEYDOWN: + begin + //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path + if (Event.key.keysym.sym = SDLK_SYSREQ) then + Display.ScreenShot + + // popup hack... if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + // end of popup hack + + else + begin + // check for Screen want to Exit + done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + + //If Screen wants to Exit + if done then + begin + //If Question Option is enabled then Show Exit Popup + if (Ini.AskbeforeDel = 1) then + begin + Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); + end + else //When asking for exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then + end; +// SDL_JOYAXISMOTION: +// begin +// beep +// end; + SDL_JOYBUTTONDOWN: + begin + beep + end; + End; // Case Event.type_ + End; // While +End; // CheckEvents + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(AktSong.BPM) = BPMNum then begin + // last BPM + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end else begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then begin + // there is still remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end else begin + // there is no remaining time + CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +// TopBeat: real; +// TempBeat: real; +// TempTime: real; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; + + (* 2 BPMs *) +{ if Length(AktSong.BPM) > 1 then begin + (* new system *) + CurBeat := 0; + TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); + if TopBeat > AktSong.BPM[1].StartBeat then begin + // analyze second BPM + Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); + CurBeat := AktSong.BPM[1].StartBeat; + TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); + Result := CurBeat + TopBeat; + + end else begin + (* pierwszy przedzial *) + Result := TopBeat; + end; + end; // if} + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end; // if +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + Result := 0; + if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; + + (* more BPMs *) + if Length(AktSong.BPM) > 1 then begin + Result := AktSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin + // full range + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin + // in the middle + Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + +{ while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end;} + end; // if} +end; + +procedure Sing(Sender: TScreenSing); +var + Pet: integer; + PetGr: integer; + CP: integer; + Done: real; + N: integer; +begin + Czas.Teraz := Czas.Teraz + TimeSkip; + + Czas.OldBeat := Czas.AktBeat; + Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.AktBeat := Floor(Czas.MidBeat); + +// Czas.OldHalf := Czas.AktHalf; +// Czas.MidHalf := Czas.MidBeat + 0.5; +// Czas.AktHalf := Floor(Czas.MidHalf); + + Czas.OldBeatC := Czas.AktBeatC; + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); + Czas.AktBeatC := Floor(Czas.MidBeatC); + + Czas.OldBeatD := Czas.AktBeatD; + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.AktBeatD := Floor(Czas.MidBeatD); + Czas.FracBeatD := Frac(Czas.MidBeatD); + + // sentences routines + for PetGr := 0 to 0 do begin;//High(Gracz) do begin + CP := PetGr; + // ustawianie starej czesci + Czas.OldCzesc := Czesci[CP].Akt; + + // wybieranie aktualnej czesci + for Pet := 0 to Czesci[CP].High do + if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; + + // czysczenie nut gracza, gdy to jest nowa plansza + // (optymizacja raz na halfbeat jest zla) + if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); + + end; // for PetGr + + // wykonuje operacje raz na beat + if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then + NewBeat(Sender); + + // make some operations on clicks + if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then + NewBeatC(Sender); + + // make some operations when detecting new voice pitch + if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then + NewBeatD(Sender); + + // wykonuje operacje w polowie beatu +// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then +// NewHalf; + + // plynnie przesuwa text + Done := 1; + for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) + and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then + Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); + + N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; + + // wylacza ostatnia nute po przejsciu + {// todo: Lyrics + if (Ini.LyricsEffect = 1) and (Done = 1) and + (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) + then Sender.LyricMain.Selected := -1; + + if Done > 1 then Done := 1; + Sender.LyricMain.Done := Done; } + + // use Done with LCD +{ with ScreenSing do begin + if LyricMain.Selected >= 0 then begin + LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); + LCD.ShowCursor; + end; + end;} + + +end; + +procedure NewSentence(Sender: TScreenSing); +var +G: Integer; +begin + // czyszczenie nut graczy + for G := 0 to High(Player) do begin + Player[G].IlNut := 0; + Player[G].HighNut := -1; + SetLength(Player[G].Nuta, 0); + end; + + // Add Words to Lyrics + with Sender do begin + {LyricMain.AddCzesc(Czesci[0].Akt); + if Czesci[0].Akt < Czesci[0].High then + LyricSub.AddCzesc(Czesci[0].Akt+1) + else + LyricSub.Clear;} + while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do + Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]); + end; + + Sender.UpdateLCD; + + //On Sentence Change... + Sender.onSentenceChange(Czesci[0].Akt); +end; + +procedure NewBeat(Sender: TScreenSing); +var + Pet: integer; +// TempBeat: integer; +begin + // ustawia zaznaczenie tekstu +// SingScreen.LyricMain.Selected := -1; + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin + // operates on currently beated note + //Todo: Lyrics + //Sender.LyricMain.Selected := Pet; + +// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); +// LCD.ShowCursor; + + //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); + LCD.ShowCursor; + + end; +end; + +procedure NewBeatC; +var + Pet: integer; +// LPT_1: integer; +// LPT_2: integer; +begin +// LPT_1 := 1; +// LPT_2 := 1; + + // beat click + if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then + Music.PlayClick; + + // debug system on LPT + if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin + //LPT_1 := 0; +// Light.LightOne(0, 150); + + Light.LightOne(1, 200); // beat light + if ParamStr(1) = '-doublelights' then + Light.LightOne(0, 200); // beat light + + +{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then + Light.LightOne(0, 150) + else + Light.LightOne(1, 150)} + end; + + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin + // click assist + if Ini.ClickAssist = 1 then + Music.PlayClick; + + //LPT_2 := 0; + if ParamStr(1) <> '-doublelights' then + Light.LightOne(0, 150); //125 + + + // drum machine +(* TempBeat := Czas.AktBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; +// if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) + end; + + {$IFDEF UseSerialPort} + // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$ENDIF} +end; + +procedure NewBeatD(Sender: TScreenSing); +begin + NewNote(Sender); +end; + +//procedure NewHalf; +//begin +// NewNote; +//end; + +procedure NewNote(Sender: TScreenSing); +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Pet: integer; + Mozna: boolean; + Nowa: boolean; + Range: integer; + NoteHit:boolean; +begin +// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); +// beep; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do begin + + // analyze buffer + Sound[CP].AnalizujBufor; + + // adds some noise +// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; + + // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Czesci[0].Akt-1; + if SMin < 0 then SMin := 0; + SMax := Czesci[0].Akt; + + // check if we can add new note + Mozna := false; + SDet:=SMin; + for S := SMin to SMax do + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) + and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 + then begin + SDet := S; + Mozna := true; + Break; + end; + + S := SDet; + + + + + +// Czas.SzczytJest := true; +// Czas.Ton := 27; + + // gdy moze, to dodaje nute + if (Sound[CP].SzczytJest) and (Mozna) then begin + // operowanie na ostatniej nucie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + Sound[CP].Ton := Sound[CP].Ton - 12; + while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + Sound[CP].Ton := Sound[CP].Ton + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin + Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + + // Half size Notes Patch + NoteHit := true; + + + if (Ini.LineBonus = 0) then + begin + // add points without LineBonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end + else + begin + // add points with Line Bonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then begin + Nowa := true; + // jezeli ostatnia ma ten sam ton + if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) + then Nowa := false; + // jezeli jest jakas nowa nuta na sprawdzanym beacie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then + Nowa := true; + + // dodawanie nowej nuty + if Nowa then begin + // nowa nuta + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNut := Player[CP].HighNut + 1; + SetLength(Player[CP].Nuta, Player[CP].IlNut); + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; + Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + + + // Half Note Patch + Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; + + + // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); + + end else begin + // przedluzenie nuty + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; + end; + + + // check for perfect note and then lit the star (on Draw) + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) + and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin + Player[CP].Nuta[Player[CP].HighNut].Perfect := true; + end; + + end;// else beep; // if S = SMax + + end; // if moze + end; // for CP +// Log.LogStatus('EndBeat', 'NewBeat'); + +//On Sentence End -> For LineBonus + SingBar +if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then +if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then + Sender.onSentenceEnd(sDet); + +end; + +procedure ClearScores(PlayerNum: integer); +begin + Player[PlayerNum].Score := 0; + Player[PlayerNum].ScoreI := 0; + Player[PlayerNum].ScoreLine := 0; + Player[PlayerNum].ScoreLineI := 0; + Player[PlayerNum].ScoreGolden := 0; + Player[PlayerNum].ScoreGoldenI := 0; + Player[PlayerNum].ScoreTotalI := 0; +end; + +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; + + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + lAttrib : integer; + begin + lWriteable := false; + aPathVar := aLocation; + + // Make sure the directory is needex + ForceDirectories(aPathVar); + + If DirectoryExists(aPathVar) then + begin + lAttrib := fileGetAttr('C:Temp'); + + lWriteable := ( lAttrib and faDirectory <> 0 ) AND + NOT ( lAttrib and faReadOnly <> 0 ) + end; + + if not lWriteable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; + +begin + + GamePath := ExtractFilePath(ParamStr(0)); + + initialize_path( LogPath , GamePath ); + initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); + initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); + initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); + initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); + initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); + initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); + initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); + initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); + + DecimalSeparator := ','; +end; + +end. + diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index b9f93b29..b3729e69 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -1,735 +1,738 @@ -unit UMusic; - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - UCommon, - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - {$IFDEF useBASS} - bass, - {$ENDIF} - ULog, - USongs; - - -procedure InitializeSound; - -type - TSoundCard = record - Name: string; - Source: array of string; - end; - - TFFTData = array [0..256] of Single; - - TCustomSoundEntry = record - Filename : String; - Handle : hStream; - end; - - - TMusic = class - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - - - Loaded: boolean; - Loop: boolean; - public - Bass: hStream; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function Position: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal); - -end; - -const - RecordSystem = 1; - -type - TMuzyka = record - Path: string; - Start: integer; // start of song in ms - IlNut: integer; - DlugoscNut: integer; - end; - - PLine = ^TLine; - TLine = record - Start: integer; - StartNote: integer; - Lyric: string; - LyricWidth: real; - Koniec: integer; - BaseNote: integer; - HighNut: integer; - IlNut: integer; - TotalNotes: integer; - Nuta: array of record - Color: integer; - Start: integer; - Dlugosc: integer; - Ton: integer; - TonGamy: integer; - Tekst: string; - FreeStyle: boolean; - Wartosc: integer; // zwykla nuta x1, zlota nuta x2 - end; - end; - ALine = array of TLine; - - TCzesci = record - Akt: integer; // aktualna czesc utworu do rysowania - High: integer; - Ilosc: integer; - Resolution: integer; - NotesGAP: integer; - Wartosc: integer; - Czesc: ALine; - end; - - TCzas = record // wszystko, co dotyczy aktualnej klatki - OldBeat: integer; // poprzednio wykryty beat w utworze - AktBeat: integer; // aktualny beat w utworze - MidBeat: real; // dokladny AktBeat - - // now we use this for super synchronization! - // only used when analyzing voice - OldBeatD: integer; // poprzednio wykryty beat w utworze - AktBeatD: integer; // aktualny beat w utworze - MidBeatD: real; // dokladny AktBeatD - FracBeatD: real; // fractional part of MidBeatD - - // we use this for audiable clicks - OldBeatC: integer; // poprzednio wykryty beat w utworze - AktBeatC: integer; // aktualny beat w utworze - MidBeatC: real; // dokladny AktBeatC - FracBeatC: real; // fractional part of MidBeatC - - - OldCzesc: integer; // poprzednio wyswietlana czesc - // akt jest w czesci.akt - - Teraz: real; // aktualny czas w utworze - Razem: real; // caly czas utworu - end; - -var - Music: TMusic; - - // muzyka - Muzyka: TMuzyka; - - // czesci z nutami; - Czesci: array of TCzesci; - - // czas - Czas: TCzas; - - fHWND: Thandle; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -implementation - -uses - {$IFDEF FPC} - lclintf, - {$ENDIF} - UGraphic, - URecord, - UFiles, - UIni, - UMain, - UThemes; - -procedure InitializeSound; -begin - Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; - Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; -end; - -procedure TMusic.InitializePlayback; -var - Pet: integer; - S: integer; -begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB_linux find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - {$ENDIF} - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - Log.LogStatus('Loading Sounds', 'Music Initialize'); - - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TMusic.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TMusic.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); - {$ENDIF} -end; - -procedure TMusic.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - //Set Volume - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); - {$ENDIF} -end; - -procedure TMusic.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TMusic.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - {$ENDIF} - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TMusic.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TMusic.MoveTo(Time: real); -var - bytes: integer; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); - {$ENDIF} -end; - -procedure TMusic.Play; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; - {$ENDIF} -end; - -procedure TMusic.Pause; //Pause Mod -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; - {$ENDIF} -end; - -procedure TMusic.Stop; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); - {$ENDIF} -end; - -procedure TMusic.Close; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); - {$ENDIF} -end; - -function TMusic.Length: real; -var - bytes: integer; -begin - Result := 60; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); - {$ENDIF} -end; - -function TMusic.Position: real; -var - bytes: integer; -begin - Result := 0; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); - {$ENDIF} -end; - -function TMusic.Finished: boolean; -begin - Result := false; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; - {$ENDIF} -end; - -procedure TMusic.PlayStart; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); - {$ENDIF} -end; - -procedure TMusic.PlayBack; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then - {$ENDIF} -end; - -procedure TMusic.PlaySwoosh; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); - {$ENDIF} -end; - -procedure TMusic.PlayChange; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); - {$ENDIF} -end; - -procedure TMusic.PlayOption; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); - {$ENDIF} -end; - -procedure TMusic.PlayClick; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); - {$ENDIF} -end; - -procedure TMusic.PlayDrum; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); - {$ENDIF} -end; - -procedure TMusic.PlayHihat; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); - {$ENDIF} -end; - -procedure TMusic.PlayClap; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); - {$ENDIF} -end; - -procedure TMusic.PlayShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); - {$ENDIF} -end; - -procedure TMusic.StopShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); - {$ENDIF} -end; - -procedure TMusic.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; -end; - -procedure TMusic.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; - -end; - -//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if not BASS_RecordInit(RecordI) then begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; - - {$ENDIF} -end; - -procedure TMusic.StopCard(Card: byte); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; - {$ENDIF} -end; - -function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - {$ENDIF} - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TMusic.GetFFTData: TFFTData; -var -Data: TFFTData; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - //Result := Data; - - {$ENDIF} -end; - -function TMusic.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TMusic.PlayCustomSound(const Index: Cardinal); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); - - {$ENDIF} -end; - - -end. +unit UMusic; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + UCommon, + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + {$IFDEF useBASS} + bass, + {$ENDIF} + ULog, + USongs; + + +procedure InitializeSound; + +type + TSoundCard = record + Name: string; + Source: array of string; + end; + + TFFTData = array [0..256] of Single; + + TCustomSoundEntry = record + Filename : String; + Handle : hStream; + end; + + + TMusic = class + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + + + Loaded: boolean; + Loop: boolean; + public + Bass: hStream; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal); + +end; + +const + RecordSystem = 1; + +type + TMuzyka = record + Path: string; + Start: integer; // start of song in ms + IlNut: integer; + DlugoscNut: integer; + end; + + PLine = ^TLine; + TLine = record + Start: integer; + StartNote: integer; + Lyric: string; + LyricWidth: real; + Koniec: integer; + BaseNote: integer; + HighNut: integer; + IlNut: integer; + TotalNotes: integer; + Nuta: array of record + Color: integer; + Start: integer; + Dlugosc: integer; + Ton: integer; + TonGamy: integer; + Tekst: string; + FreeStyle: boolean; + Wartosc: integer; // zwykla nuta x1, zlota nuta x2 + end; + end; + ALine = array of TLine; + + TCzesci = record + Akt: integer; // aktualna czesc utworu do rysowania + High: integer; + Ilosc: integer; + Resolution: integer; + NotesGAP: integer; + Wartosc: integer; + Czesc: ALine; + end; + + TCzas = record // wszystko, co dotyczy aktualnej klatki + OldBeat: integer; // poprzednio wykryty beat w utworze + AktBeat: integer; // aktualny beat w utworze + MidBeat: real; // dokladny AktBeat + + // now we use this for super synchronization! + // only used when analyzing voice + OldBeatD: integer; // poprzednio wykryty beat w utworze + AktBeatD: integer; // aktualny beat w utworze + MidBeatD: real; // dokladny AktBeatD + FracBeatD: real; // fractional part of MidBeatD + + // we use this for audiable clicks + OldBeatC: integer; // poprzednio wykryty beat w utworze + AktBeatC: integer; // aktualny beat w utworze + MidBeatC: real; // dokladny AktBeatC + FracBeatC: real; // fractional part of MidBeatC + + + OldCzesc: integer; // poprzednio wyswietlana czesc + // akt jest w czesci.akt + + Teraz: real; // aktualny czas w utworze + Razem: real; // caly czas utworu + end; + +var + Music: TMusic; + + // muzyka + Muzyka: TMuzyka; + + // czesci z nutami; + Czesci: array of TCzesci; + + // czas + Czas: TCzas; + + fHWND: Thandle; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + UGraphic, + URecord, + UFiles, + UIni, + UMain, + UThemes; + +procedure InitializeSound; +begin + Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; + Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; +end; + +procedure TMusic.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + {$ifdef win32} + // TODO : JB_Linux ... is this needed ? :) + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + {$ENDIF} + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_linux find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + {$ENDIF} + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TMusic.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TMusic.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); + {$ENDIF} +end; + +procedure TMusic.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + //Set Volume + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + {$ENDIF} +end; + +procedure TMusic.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TMusic.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + {$ENDIF} + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TMusic.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TMusic.MoveTo(Time: real); +var + bytes: integer; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); + {$ENDIF} +end; + +procedure TMusic.Play; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; + {$ENDIF} +end; + +procedure TMusic.Pause; //Pause Mod +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; + {$ENDIF} +end; + +procedure TMusic.Stop; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); + {$ENDIF} +end; + +procedure TMusic.Close; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); + {$ENDIF} +end; + +function TMusic.Length: real; +var + bytes: integer; +begin + Result := 60; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); + {$ENDIF} +end; + +function TMusic.Position: real; +var + bytes: integer; +begin + Result := 0; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); + {$ENDIF} +end; + +function TMusic.Finished: boolean; +begin + Result := false; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; + {$ENDIF} +end; + +procedure TMusic.PlayStart; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); + {$ENDIF} +end; + +procedure TMusic.PlayBack; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then + {$ENDIF} +end; + +procedure TMusic.PlaySwoosh; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); + {$ENDIF} +end; + +procedure TMusic.PlayChange; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); + {$ENDIF} +end; + +procedure TMusic.PlayOption; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); + {$ENDIF} +end; + +procedure TMusic.PlayClick; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); + {$ENDIF} +end; + +procedure TMusic.PlayDrum; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); + {$ENDIF} +end; + +procedure TMusic.PlayHihat; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); + {$ENDIF} +end; + +procedure TMusic.PlayClap; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); + {$ENDIF} +end; + +procedure TMusic.PlayShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); + {$ENDIF} +end; + +procedure TMusic.StopShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); + {$ENDIF} +end; + +procedure TMusic.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TMusic.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if not BASS_RecordInit(RecordI) then begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; + + {$ENDIF} +end; + +procedure TMusic.StopCard(Card: byte); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; + {$ENDIF} +end; + +function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + {$ENDIF} + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end else begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TMusic.GetFFTData: TFFTData; +var +Data: TFFTData; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + //Result := Data; + + {$ENDIF} +end; + +function TMusic.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TMusic.PlayCustomSound(const Index: Cardinal); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); + + {$ENDIF} +end; + + +end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 7fdbacde..c9d7f2fd 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -1,171 +1,174 @@ -unit USkins; - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -interface - -type - TSkinTexture = record - Name: string; - FileName: string; - end; - - TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet - end; - - TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; - constructor Create; - procedure LoadList; - procedure ParseDir(Dir: string); - procedure LoadHeader(FileName: string); - procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): string; - function GetSkinNumber(Name: string): integer; - procedure onThemeChange; - end; - -var - Skin: TSkin; - -implementation - -uses IniFiles, Classes, SysUtils, ULog, UIni; - -constructor TSkin.Create; -begin - LoadList; -// LoadSkin('Lisek'); -// SkinColor := Color; -end; - -procedure TSkin.LoadList; -var - SR: TSearchRec; -// SR2: TSearchRec; -// SLen: integer; -begin - if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir('Skins'+PathDelim + SR.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); -end; - -procedure TSkin.ParseDir(Dir: string); -var - SR: TSearchRec; -// SLen: integer; -begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - LoadHeader(Dir + SR.Name); - //Log.LogError(SR.Name); - until FindNext(SR) <> 0; - end; -end; - -procedure TSkin.LoadHeader(FileName: string); -var - SkinIni: TMemIniFile; - S: integer; -begin - SkinIni := TMemIniFile.Create(FileName); - - S := Length(Skin); - SetLength(Skin, S+1); - Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); - Skin[S].FileName := ExtractFileName(FileName); - Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); - Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); - Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); - - SkinIni.Free; -end; - -procedure TSkin.LoadSkin(Name: string); -var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; -begin - S := GetSkinNumber(Name); - SkinPath := Skin[S].Path; - - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); - - SL := TStringList.Create; - SkinIni.ReadSection('Textures', SL); - - SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do begin - SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); - end; - - SL.Free; - SkinIni.Free; -end; - -function TSkin.GetTextureFileName(TextureName: string): string; -var - T: integer; -begin - Result := ''; - - for T := 0 to High(SkinTexture) do - begin - if ( SkinTexture[T].Name = TextureName ) AND - ( SkinTexture[T].FileName <> '' ) then - begin - Result := SkinPath + SkinTexture[T].FileName; - end; - end; - -{ Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} -end; - -function TSkin.GetSkinNumber(Name: string): integer; -var - S: integer; -begin - Result := 0; // set default to the first available skin - for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; -end; - -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; -begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; - end; - -end; - -end. +unit USkins; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +interface + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, Classes, SysUtils, ULog, UIni; + +constructor TSkin.Create; +begin + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; +// SR2: TSearchRec; +// SLen: integer; +begin + if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir('Skins'+PathDelim + SR.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; +// SLen: integer; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + //Log.LogError(SR.Name); + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + + for T := 0 to High(SkinTexture) do + begin + if ( SkinTexture[T].Name = TextureName ) AND + ( SkinTexture[T].FileName <> '' ) then + begin + Result := SkinPath + SkinTexture[T].FileName; + end; + end; + + Log.LogStatus('', '-----------------------------------------'); + Log.LogStatus(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + Ini.SkinNo:=0; + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f5169e8c..173fbd4c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1098 +1,1151 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - - - {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - {$ENDIF} - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - function LoadImage(Identifier: PChar): PSDL_Surface; - function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; - procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); - function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; - procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - - public - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) -// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) -// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) -// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF FPC} - LResources, - {$ENDIF} - StrUtils, dialogs; - -const - fmt_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); - fmt_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); - - -Constructor TTextureUnit.Create; -begin - inherited Create; -end; - -Destructor TTextureUnit.Destroy; -begin - inherited Destroy; -end; - -function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; -end; - -// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ - 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; -// ----------------------------------------------- - -function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF FPC} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource', ' LoadImage' ); - - // load from resource stream - {$IFNDEF FPC} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource', ' LoadImage' ); - end; - {$ENDIF} - - - end; -end; - -procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_rgb; - - - if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then - begin - TempSurface:=TexSurface; - TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - Result:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); -end; - -procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - TexSurface:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - with TempSurface^.format^ do - TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); - SDL_SetAlpha(TexSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface,nil,TexSurface,nil); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - //returns hue within range [0.0-6.0) - function col2h(Color:Cardinal):double; - var - clr,hls: array[0..2] of double; - delta: double; - begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; - end; - procedure ColorizePixel(Pix: PByteArray; hue: Double); - var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; - begin - hls[0]:=hue; - - clr[0] := Pix[0]/255; - clr[1] := Pix[1]/255; - clr[2] := Pix[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) - // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - DestinationHue:=col2h(Col); - for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do - ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: Cardinal; -begin - Log.BenchmarkStart(4); - Mipmapping := true; -(* - Log.LogStatus( '', '' ); - - if Identifier = nil then - Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') - else - Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); -*) - - // load texture data into memory - {$ifdef blindydebug} - Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - // convert pixel format as needed - {$ifdef blindydebug} - Log.LogStatus('',' AdjustPixelFormat'); - {$endif} - AdjustPixelFormat(TexSurface, Typ); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - // adjust texture size (scale down, if necessary) - newWidth:=TexSurface.W; - newHeight:=TexSurface.H; - if (newWidth > Limit) then - newWidth:=Limit; - if (newHeight > Limit) then - newHeight:=Limit; - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ScaleTexture'); - {$endif} - ScaleTexture(TexSurface,newWidth,newHeight); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end; - - // don't actually understand, if this is needed... - // this should definately be changed... together with all this - // cover cache stuff - if (CreateCacheMipmap) and (Typ='Plain') then - begin - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - if assigned(MipmapSurface) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' BlitSurface Stuff'); - {$endif} - // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end - else - begin - Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); - end; - end; - // should i create a cache texture, if Covers.W/H are larger? - end; - - // now we might colorize the whole thing - if Typ='Colorized' then ColorizeTexture(TexSurface,Col); - // save actual dimensions of our texture - oldWidth:=newWidth; - oldHeight:=newHeight; - // make texture dimensions be powers of 2 - newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); - newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitTexture(TexSurface,newWidth,newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - glGenTextures(1, ActTex); - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - // load data into gl texture - if (Typ = 'Transparent') or (Typ='Colorized') then begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; -{ - if Typ = 'Transparent Range' then - // set alpha to 256-green-component (not sure) - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; -} -{ - if Typ = 'Font' then - // either create luminance-alpha texture - // or use transparency from differently saved file - // or do something totally different (text engine with ttf) - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then - begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Identifier; - - SDL_FreeSurface(TexSurface); - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - - if Name = '' then - exit; - - // find texture entry - T := FindTexture(Name); - - if T = -1 then - begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then - begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$ifdef blindydebug} - Log.LogStatus('done',' '); - {$endif} - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - end; - - if FromCache and Covers.CoverExists(Name) then - begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF FPC} -{$IFDEF win32} -initialization - {$I UltraStar.lrs} -{$ENDIF} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + +(* + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: PGLuint); stdcall; external opengl32; +*) + {$ENDIF} + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF FPC} + LResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; +end; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF FPC} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFNDEF FPC} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ENDIF} + + + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1'); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! + {$IFnDEF win32} + if pointer(ActTex) = nil then + exit; + {$endif} + + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = 'Transparent') or (Typ='Colorized') then begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF FPC} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 9da176df..00b763f0 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -1,2200 +1,2212 @@ -unit UThemes; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses - ULog, - IniFiles, - SysUtils, - Classes; - -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: string; - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - //Reflection Mod - 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; - 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: string; - - 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; - 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; - - 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: TThemeSelect; - SelectSolmization: TThemeSelect; - ButtonExit: TThemeButton; - end; - - TThemeOptionsThemes = class(TThemeBasic) - SelectTheme: TThemeSelectSlide; - SelectSkin: TThemeSelectSlide; - SelectColor: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsRecord = class(TThemeBasic) - SelectSlideCard: TThemeSelectSlide; - SelectSlideInput: TThemeSelectSlide; - SelectSlideChannelL: TThemeSelectSlide; - SelectSlideChannelR: 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: String; - FirstColor: String; - - SecondTexture: String; - SecondTyp: String; - SecondColor: String; - - ThirdTexture: String; - ThirdTyp: String; - 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; - 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 -{{$IFDEF TRANSLATE} - ULanguage, -{{$ENDIF} - USkins, - UIni; - -constructor TTheme.Create(FileName: string); -begin - Create(FileName, 0); -end; - -constructor TTheme.Create(FileName: string; Color: integer); -begin - 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; - 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 - - {{$IFDEF TRANSLATE} - 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'); - {{$ENDIF} - - //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'); - - // 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)); - 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'); - - {{$IFDEF TRANSLATE} - Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); - Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); - Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); - Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); - Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); - Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); - Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED'); - Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); - {{$ENDIF} - - 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'); - ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - 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.SelectSlideChannelL, 'OptionsRecordSelectSlideChannelL'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); - 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 := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); - PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); - - PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); - PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); - PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); - - PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); - PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); - 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 - DecimalSeparator := '.'; - - 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', ''); - - 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; - - DecimalSeparator := ','; -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 - DecimalSeparator := '.'; - - 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 := ThemeIni.ReadString(Name, 'Type', ''); - 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); - - DecimalSeparator := ','; -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; - DecimalSeparator := '.'; - 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 := ThemeIni.ReadString(Name, 'Type', ''); - - //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)); - - DecimalSeparator := ','; -end; - -procedure TTheme.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); -var - C: integer; -begin - DecimalSeparator := '.'; - - {{$IFDEF TRANSLATE} - ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {{$ELSE}{ - ThemeSelect.Text := ThemeIni.ReadString(Name, 'Text', ''); - {$ENDIF} - - 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); - - - DecimalSeparator := ','; -end; - -procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); -var - C: integer; -begin - DecimalSeparator := '.'; - - {{$IFDEF TRANSLATE} - ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - {{$ELSE}{ - ThemeSelectS.Text := ThemeIni.ReadString(Name, 'Text', ''); - {$ENDIF} - - 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); - - - DecimalSeparator := ','; -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 - DecimalSeparator := '.'; - 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', 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); - - DecimalSeparator := ','; -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 - DecimalSeparator := '.'; - 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); - - DecimalSeparator := ','; -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 - DecimalSeparator := '.'; - 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', 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)); - - DecimalSeparator := ','; -end; - - -end. +unit UThemes; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + ULog, + IniFiles, + SysUtils, + Classes; + +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: string; + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + //Reflection Mod + 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; + 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: string; + + 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; + 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; + + 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: TThemeSelect; + SelectSolmization: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsThemes = class(TThemeBasic) + SelectTheme: TThemeSelectSlide; + SelectSkin: TThemeSelectSlide; + SelectColor: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsRecord = class(TThemeBasic) + SelectSlideCard: TThemeSelectSlide; + SelectSlideInput: TThemeSelectSlide; + SelectSlideChannelL: TThemeSelectSlide; + SelectSlideChannelR: 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: String; + FirstColor: String; + + SecondTexture: String; + SecondTyp: String; + SecondColor: String; + + ThirdTexture: String; + ThirdTyp: String; + 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; + 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 + 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; + + FileName := AdaptFilePaths( FileName ); + + if not FileExists(FileName) then + begin + {$ifndef win32} + writeln( 'ERROR !!! Theme does not exist ('+ FileName +')' ); + {$endif} + + Log.LogStatus( 'ERROR !!! 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 + + //{$IFDEF TRANSLATE} + 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'); + //{$ENDIF} + + //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'); + + // 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)); + 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'); + + //{$IFDEF TRANSLATE} + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); + Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED'); + Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); + //{$ENDIF} + + 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'); + ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + 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.SelectSlideChannelL, 'OptionsRecordSelectSlideChannelL'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); + 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 := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); + 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 + DecimalSeparator := '.'; + + 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', ''); + + 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; + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + + 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 := ThemeIni.ReadString(Name, 'Type', ''); + 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); + + DecimalSeparator := ','; +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; + DecimalSeparator := '.'; + 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 := ThemeIni.ReadString(Name, 'Type', ''); + + //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)); + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + //{$IFDEF TRANSLATE} + ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + //{$ELSE}{ + //ThemeSelect.Text := ThemeIni.ReadString(Name, 'Text', ''); + //{$ENDIF} + + 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); + + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + //{{$IFDEF TRANSLATE} + ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + //{{$ELSE}{ + //ThemeSelectS.Text := ThemeIni.ReadString(Name, 'Text', ''); + //{$ENDIF} + + 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); + + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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', 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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', 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)); + + DecimalSeparator := ','; +end; + + +end. diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index 87d4f922..d06628cc 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -69,7 +69,11 @@ begin TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at {$ENDIF} - TimeSkip := (TimeNew-TimeOld)/TimeFreq; + if ( TimeNew-TimeOld > 0 ) AND + ( TimeFreq > 0 ) THEN + begin + TimeSkip := (TimeNew-TimeOld)/TimeFreq; + end; end; procedure CountMidTime; -- cgit v1.2.3 From ad7420f5a6d81e43bd098ea7c972fd4bc2ca1f26 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 04:48:42 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@461 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 173fbd4c..b18724bf 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -39,7 +39,7 @@ uses OpenGL12, {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; +// procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; (* {$ELSE} -- cgit v1.2.3 From b50f5d910e081bc1dd6925e84874d97b7de46d9c Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 05:00:37 +0000 Subject: oops AdaptFilePaths was meant to be available to any compiler. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@462 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 7337751a..5b911da0 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -32,9 +32,6 @@ type type TWndMethod = procedure(var Message: TMessage) of object; -function StringReplaceW(text, search, rep: WideString):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - function LazFindResource( const aName, aType : String ): TLResource; function RandomRange(aMin: Integer; aMax: Integer) : Integer; @@ -45,9 +42,13 @@ function MinValue(const Data: array of Double): Double; {$IFDEF Win32} function AllocateHWnd(Method: TWndMethod): HWND; procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} +{$ENDIF} // Win32 + +{$ENDIF} // FPC Only + +function StringReplaceW(text, search, rep: WideString):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; -{$ENDIF} {$IFNDEF win32} (* -- cgit v1.2.3 From 52c0cd1ee199b9ee30adafaa7e034d9e02055278 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 10:18:25 +0000 Subject: fixed bug in StringReplaceW... oops :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@463 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 5b911da0..af9ae82d 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -46,7 +46,7 @@ procedure DeallocateHWnd(Wnd: HWND); {$ENDIF} // FPC Only -function StringReplaceW(text, search, rep: WideString):WideString; +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; function AdaptFilePaths( const aPath : widestring ): widestring; @@ -60,18 +60,30 @@ function AdaptFilePaths( const aPath : widestring ): widestring; implementation -function StringReplaceW(text, search, rep: WideString):WideString; +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; var iPos : integer; - sTemp : WideString; +// sTemp : WideString; begin +(* result := text; iPos := Pos(search, result); while (iPos > 0) do begin - sTEmp := copy(result, iPos + length(search), length(result)); + sTemp := copy(result, iPos + length(search), length(result)); result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); + 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; -- cgit v1.2.3 From fdb75fa47dd72522b705e94be5a201c4e1a731cb Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 3 Oct 2007 12:43:01 +0000 Subject: New plugin SDK added Some more debug information for windows builds (Does this work in lazarus?) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@466 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 16 ++- Game/Code/Classes/UPluginInterface.pas | 179 +++++++++++++++++++++++++++++++++ 2 files changed, 191 insertions(+), 4 deletions(-) create mode 100644 Game/Code/Classes/UPluginInterface.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 7c93c6e9..7e464b57 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -188,6 +188,11 @@ begin FileErrorO := false; end; end; + {$DEFINE DEBUG} //How can i check if this is set in *.dpr file o0 + //If Debug => Write to Console Output + {$IFDEF DEBUG} + WriteLn('Error: ' + Text); + {$ENDIF} end; procedure TLog.LogVoice(SoundNr: integer); @@ -219,10 +224,13 @@ end; procedure TLog.LogStatus(Log1, Log2: string); begin //Just for Debugging - //Comment for Release - //LogAnalyze (Log2 + ': ' + Log1); - - LogError(Log2 + ': ' + Log1); + //Comment for Release + //LogError(Log2 + ': ' + Log1); + + //If Debug => Write to Console Output + {$IFDEF DEBUG} + WriteLn(Log2 + ': ' + Log1); + {$ENDIF} end; procedure TLog.LogError(Log1, Log2: string); diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas new file mode 100644 index 00000000..6d17d51d --- /dev/null +++ b/Game/Code/Classes/UPluginInterface.pas @@ -0,0 +1,179 @@ +unit uPluginInterface; +{********************* + uPluginInterface + Unit fills a TPluginInterface Structur with Method Pointers + Unit Contains all Functions called directly by Plugins +*********************} + +interface +uses uPluginDefs; + +//--------------- +// Procedure that Sets the PluginInterface Record +//--------------- + Procedure Init_PluginInterface; + +//--------------- +// 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, lParam: dWord): 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, lParam: dWord): integer; stdcall; + + {Function Returns Non Zero if a Service with the given Name Exists, + otherwise 0} + Function ServiceExists (ServiceName: PChar): Integer; stdcall; + +var + PluginInterface: TUS_PluginInterface; + +implementation + +//--------------- +// Procedure that Sets the PluginInterface Record +//--------------- +Procedure Init_PluginInterface; +begin + 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; +end; + + +{******** 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 + +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 + +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, lParam: dWord): integer; stdcall; +begin + +end; + +//--------------- +// Function Hooks an Event by Name. +// Returns Hook Handle on Success, otherwise 0 +//--------------- +Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; +begin + +end; + +//--------------- +// Function Removes the Hook from the Chain +// Returns 0 on Success +//--------------- +Function UnHookEvent (hHook: THandle): Integer; stdcall; +begin + +end; + +//--------------- +// Function Returns Non Zero if a Event with the given Name Exists, +// otherwise 0 +//--------------- +Function EventExists (EventName: PChar): Integer; stdcall; +begin + +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 + +end; + +//--------------- +// Function Destroys a Service. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyService (hService: THandle): integer; stdcall; +begin + +end; + +//--------------- +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//--------------- +Function CallService (ServiceName: PChar; wParam, lParam: dWord): integer; stdcall; +begin + +end; + +//--------------- +// Function Returns Non Zero if a Service with the given Name Exists, +// otherwise 0 +//--------------- +Function ServiceExists (ServiceName: PChar): Integer; stdcall; +begin + +end; + +end. -- cgit v1.2.3 From b9263037c17ed6caa573478d4bf86dcc83026660 Mon Sep 17 00:00:00 2001 From: mogguh Date: Wed, 3 Oct 2007 15:17:19 +0000 Subject: Actually just a test if the new CIA filtering works git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@467 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTextClasses.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas index 5f66d0e8..5a0655e5 100644 --- a/Game/Code/Classes/UTextClasses.pas +++ b/Game/Code/Classes/UTextClasses.pas @@ -25,7 +25,7 @@ type deconstructor procedure ReleaseTextures(); end; -// okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P +// (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 -- cgit v1.2.3 From 979d59410f1625a4943a8a84e0f204465800453f Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 8 Oct 2007 00:19:58 +0000 Subject: fixed some stuff for linux build... now its getting close to the look of the windows build... YAY ! see http://www.flickr.com/photos/31428768@N00/sets/72157602234125005/ git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@468 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 36 +- Game/Code/Classes/UVideo.pas | 866 ++++++++++++++++++++++------------------- 2 files changed, 476 insertions(+), 426 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index b18724bf..5ef29316 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -37,22 +37,6 @@ uses OpenGL12, sdlutils, SDL_Image; - - {$IFDEF Win32} -// procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - -(* - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: PGLuint); stdcall; external opengl32; -*) - {$ENDIF} - type TTexture = record TexNum: integer; @@ -525,6 +509,7 @@ begin // load texture data into memory {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); {$endif} TexSurface := LoadImage(Identifier); @@ -537,6 +522,7 @@ begin beep; Exit; end; + // convert pixel format as needed {$ifdef blindydebug} Log.LogStatus('',' AdjustPixelFormat'); @@ -567,7 +553,7 @@ begin end; {$ifdef blindydebug} - Log.LogStatus('',' JB-1'); + Log.LogStatus('',' JB-1 : typ='+Typ); {$endif} @@ -577,6 +563,10 @@ begin // cover cache stuff if (CreateCacheMipmap) and (Typ='Plain') then begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + if (Covers.W <= 256) and (Covers.H <= 256) then begin {$ifdef blindydebug} @@ -645,10 +635,10 @@ begin // prepare OpenGL texture // JB_linux : this is causing AV's on linux... ActText seems to be nil ! - {$IFnDEF win32} - if pointer(ActTex) = nil then - exit; - {$endif} +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} glGenTextures(1, @ActTex); @@ -658,7 +648,9 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); // load data into gl texture - if (Typ = 'Transparent') or (Typ='Colorized') then begin + if (Typ = 'Transparent') or + (Typ='Colorized') then + begin glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); end {if Typ = 'Plain' then} else diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 290db271..b2ba01dc 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -1,404 +1,462 @@ -{############################################################################ -# FFmpeg support for UltraStar deluxe # -# # -# Created by b1indy # -# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # -#############################################################################} - -//{$define DebugDisplay} // uncomment if u want to see the debug stuff -//{$define DebugFrames} -//{$define Info} - - -unit UVideo; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -uses SDL, - UGraphicClasses, - textgl, - avcodec, - avformat, - avutil, - math, - OpenGL12, - SysUtils, - {$ifdef DebugDisplay} - dialogs, - {$ENDIF} - UIni; - -procedure Init; -procedure FFmpegOpenFile(FileName: pAnsiChar); -procedure FFmpegClose; -procedure FFmpegGetFrame(Time: Extended); -procedure FFmpegDrawGL(Screen: integer); -procedure FFmpegTogglePause; -procedure FFmpegSkip(Time: Single); - -var - VideoOpened, VideoPaused: Boolean; - VideoFormatContext: PAVFormatContext; - VideoStreamIndex: Integer; - VideoCodecContext: PAVCodecContext; - VideoCodec: PAVCodec; - AVFrame: PAVFrame; - AVFrameRGB: PAVFrame; - myBuffer: pByte; - VideoTex: glUint; - TexX, TexY, dataX, dataY: Cardinal; - TexData: array of Byte; - ScaledVideoWidth, ScaledVideoHeight: Real; - VideoAspect: Real; - VideoTextureU, VideoTextureV: Real; - VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; - VideoSkipTime: Single; - -implementation - -procedure Init; -begin - av_register_all; - VideoOpened:=False; - VideoPaused:=False; - glGenTextures(1, PglUint(@VideoTex)); - SetLength(TexData,0); -end; - -procedure FFmpegOpenFile(FileName: pAnsiChar); -var errnum, i, x,y: Integer; -begin - VideoOpened:=False; - VideoPaused:=False; - VideoTimeBase:=0; - VideoTime:=0; - LastFrameTime:=0; - TimeDifference:=0; - errnum:=av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); - if(errnum <> 0) - then begin -{$ifdef DebugDisplay} - case errnum of - AVERROR_UNKNOWN: showmessage('failed to open file '+Filename+#13#10+'AVERROR_UNKNOWN'); - AVERROR_IO: showmessage('failed to open file '+Filename+#13#10+'AVERROR_IO'); - AVERROR_NUMEXPECTED: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NUMEXPECTED'); - AVERROR_INVALIDDATA: showmessage('failed to open file '+Filename+#13#10+'AVERROR_INVALIDDATA'); - AVERROR_NOMEM: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOMEM'); - AVERROR_NOFMT: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOFMT'); - AVERROR_NOTSUPP: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOTSUPP'); - else showmessage('failed to open file '+Filename+#13#10+'Error number: '+inttostr(Errnum)); - end; -{$ENDIF} - Exit; - end - else begin - VideoStreamIndex:=-1; - if(av_find_stream_info(VideoFormatContext)>=0) then - begin - for i:=0 to VideoFormatContext^.nb_streams-1 do - if(VideoFormatContext^.streams[i]^.codec^.codec_type=CODEC_TYPE_VIDEO) then begin - VideoStreamIndex:=i; - end else - end; - if(VideoStreamIndex >= 0) then - begin - VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; - VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); - end else begin -{$ifdef DebugDisplay} - showmessage('found no video stream'); -{$ENDIF} - av_close_input_file(VideoFormatContext); - Exit; - end; - if(VideoCodec<>Nil) then - begin - errnum:=avcodec_open(VideoCodecContext, VideoCodec); - end else begin -{$ifdef DebugDisplay} - showmessage('no matching codec found'); -{$ENDIF} - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - Exit; - end; - if(errnum >=0) then - begin -{$ifdef DebugDisplay} - showmessage('Found a matching Codec:'+#13#10#13#10+ - 'Width='+inttostr(VideoCodecContext^.width)+ - ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ - 'Aspect: '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ - '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; - end; - myBuffer:=Nil; - if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then - begin - myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, - VideoCodecContext^.height)); - end; - if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, - VideoCodecContext^.width, VideoCodecContext^.height) - else begin -{$ifdef DebugDisplay} - showmessage('failed to allocate video buffer'); -{$endif} - av_free(AVFrameRGB); - av_free(AVFrame); - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - Exit; - end; - if errnum >=0 then - begin - VideoOpened:=True; - - TexX := VideoCodecContext^.width; - TexY := VideoCodecContext^.height; - dataX := Round(Power(2, Ceil(Log2(TexX)))); - dataY := Round(Power(2, Ceil(Log2(TexY)))); - SetLength(TexData,dataX*dataY*3); - // calculate some information for video display - VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; - if (VideoAspect = 0) then - VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height - else - VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; - if VideoAspect >= 4/3 then - begin - ScaledVideoWidth:=800.0; - ScaledVideoHeight:=800.0/VideoAspect; - end else - begin - ScaledVideoHeight:=600.0; - ScaledVideoWidth:=600.0*VideoAspect; - end; - VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; - // hack to get reasonable timebase for divx -{$ifdef DebugDisplay} - showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); -{$endif} - if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps - begin - VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; - while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; - VideoTimeBase:=1/VideoTimeBase; - end; -{$ifdef DebugDisplay} - showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); - if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then - showmessage('you are trying to play a rather large video'+#13#10+ - 'be prepared to experience some timing problems'); -{$endif} - end; - end; -end; - -procedure FFmpegClose; -begin - if VideoOpened then begin - av_free(myBuffer); - av_free(AVFrameRGB); - av_free(AVFrame); - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - SetLength(TexData,0); - VideoOpened:=False; - end; -end; - -procedure FFmpegTogglePause; -begin - if VideoPaused then VideoPaused:=False - else VideoPaused:=True; -end; - -procedure FFmpegSkip(Time: Single); -begin - VideoSkiptime:=Time; - if VideoSkipTime > 0 then begin - av_seek_frame(VideoFormatContext,-1,Floor((VideoSkipTime)*1500000),0); - VideoTime:=VideoSkipTime; - end; -end; - -procedure FFmpegGetFrame(Time: Extended); -var - FrameFinished: Integer; - AVPacket: TAVPacket; - errnum, x, y: Integer; - FrameDataPtr: PByteArray; - linesize: integer; - myTime: Extended; - DropFrame: Boolean; - droppedFrames: Integer; -const - FRAMEDROPCOUNT=3; -begin - if not VideoOpened then Exit; - if VideoPaused then Exit; - myTime:=Time+VideoSkipTime; - TimeDifference:=myTime-VideoTime; - DropFrame:=False; -{ showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ - 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); -} - 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} -{ showmessage('not getting new frame'+#13#10+ - 'Time: '+inttostr(floor(Time*1000))+#13#10+ - 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); -} - Exit;// we don't need a new frame now - end; - VideoTime:=VideoTime+VideoTimeBase; - TimeDifference:=myTime-VideoTime; - if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then begin // skip frames -{$ifdef DebugFrames} - //frame drop debug display - GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); -{$endif} -// showmessage('skipping frames'+#13#10+ -// 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ -// 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ -// 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); -// av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time*VideoTimeBase),0); -{ av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); - VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} - VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; - DropFrame:=True; - end; - - av_init_packet(@AVPacket); - FrameFinished:=0; - // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do - begin - // if we got a packet from the video stream, then decode it - if (AVPacket.stream_index=VideoStreamIndex) then - errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, - AVPacket.data, AVPacket.size); - // release internal packet structure created by av_read_frame - av_free_packet(PAVPacket(@AVPacket)); - end; - if DropFrame then - for droppedFrames:=1 to FRAMEDROPCOUNT do begin - FrameFinished:=0; - // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do - begin - // if we got a packet from the video stream, then decode it - if (AVPacket.stream_index=VideoStreamIndex) then - errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, - AVPacket.data, AVPacket.size); - // release internal packet structure created by av_read_frame - av_free_packet(PAVPacket(@AVPacket)); - end; - end; - - // if we did not get an new frame, there's nothing more to do - if Framefinished=0 then begin - GoldenRec.Spawn(220,15,1,16,0,-1,ColoredStar,$0000ff); - Exit; - end; - // otherwise we convert the pixeldata from YUV to RGB - errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, - PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, - VideoCodecContext^.width, VideoCodecContext^.height); -//errnum:=1; - if errnum >=0 then begin - // copy RGB pixeldata to our TextureBuffer - // (line by line) - FrameDataPtr:=AVFrameRGB^.data[0]; - linesize:=AVFrameRGB^.linesize[0]; - for y:=0 to TexY-1 do begin - System.Move(FrameDataPtr[y*linesize],TexData[3*y*dataX],linesize); - end; - - // generate opengl texture out of whatever we got - glBindTexture(GL_TEXTURE_2D, VideoTex); - glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, TexData); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); -{$ifdef DebugFrames} - //frame decode debug display - GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); -{$endif} - - end; -end; - -procedure FFmpegDrawGL(Screen: integer); -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 VideoOpened then Exit; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glColor4f(1, 1, 1, 1); - glBindTexture(GL_TEXTURE_2D, VideoTex); - glbegin(gl_quads); - glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); - glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); - glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2); - glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2); - glEnd; - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - -{$ifdef Info} - if VideoSkipTime+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; - -end. +{############################################################################ +# FFmpeg support for UltraStar deluxe # +# # +# Created by b1indy # +# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # +#############################################################################} + +//{$define DebugDisplay} // uncomment if u want to see the debug stuff +//{$define DebugFrames} +//{$define Info} + + +unit UVideo; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +uses SDL, + UGraphicClasses, + textgl, + avcodec, + avformat, + avutil, + math, + OpenGL12, + SysUtils, + {$ifdef DebugDisplay} + {$ifdef win32} + dialogs, + {$endif} + {$ENDIF} + UIni; + +procedure Init; +procedure FFmpegOpenFile(FileName: pAnsiChar); +procedure FFmpegClose; +procedure FFmpegGetFrame(Time: Extended); +procedure FFmpegDrawGL(Screen: integer); +procedure FFmpegTogglePause; +procedure FFmpegSkip(Time: Single); + +var + VideoOpened, VideoPaused: Boolean; + VideoFormatContext: PAVFormatContext; + VideoStreamIndex: Integer; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + myBuffer: pByte; + VideoTex: glUint; + TexX, TexY, dataX, dataY: Cardinal; + TexData: array of Byte; + ScaledVideoWidth, ScaledVideoHeight: Real; + VideoAspect: Real; + VideoTextureU, VideoTextureV: Real; + VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; + VideoSkipTime: Single; + +implementation + +{$ifdef DebugDisplay} +{$ifNdef win32} + +procedure showmessage( aMessage : String ); +begin + writeln( aMessage ); +end; + +{$endif} +{$ENDIF} + +procedure Init; +begin + av_register_all; + {$ifdef DebugDisplay} + showmessage( 'AV_Register_ALL' ); + {$endif} + + VideoOpened:=False; + VideoPaused:=False; + + glGenTextures(1, PglUint(@VideoTex)); + SetLength(TexData,0); +end; + +procedure FFmpegOpenFile(FileName: pAnsiChar); +var errnum, i, x,y: Integer; + lStreamsCount : Integer; +begin + VideoOpened := False; + VideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + LastFrameTime := 0; + TimeDifference := 0; + + errnum := av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); + + if(errnum <> 0) then + begin +{$ifdef DebugDisplay} + case errnum of + AVERROR_UNKNOWN: showmessage('failed to open file '+Filename+#13#10+'AVERROR_UNKNOWN'); + AVERROR_IO: showmessage('failed to open file '+Filename+#13#10+'AVERROR_IO'); + AVERROR_NUMEXPECTED: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NUMEXPECTED'); + AVERROR_INVALIDDATA: showmessage('failed to open file '+Filename+#13#10+'AVERROR_INVALIDDATA'); + AVERROR_NOMEM: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOMEM'); + AVERROR_NOFMT: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOFMT'); + AVERROR_NOTSUPP: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOTSUPP'); + else showmessage('failed to open file '+Filename+#13#10+'Error number: '+inttostr(Errnum)); + end; +{$ENDIF} + Exit; + end + else + begin + VideoStreamIndex:=-1; + + // Find which stream contains the video + if(av_find_stream_info(VideoFormatContext) >= 0) then + begin + {$ifdef DebugDisplay} + writeln( 'FFMPEG debug... VideoFormatContext^.nb_streams : '+ inttostr( VideoFormatContext^.nb_streams ) ); + {$endif} + for i:= 0 to MAX_STREAMS-1 do + begin + {$ifdef DebugDisplay} + writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' stream val ' + inttostr( integer(VideoFormatContext^.streams[i] ) ) ); + {$endif} + try + if assigned( VideoFormatContext ) AND + assigned( VideoFormatContext^.streams[i] ) AND + assigned( VideoFormatContext^.streams[i]^.codec ) THEN + begin + {$ifdef DebugDisplay} + writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' code val ' + inttostr( integer(VideoFormatContext^.streams[i].codec ) ) ); + writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' code Type ' + inttostr( integer(VideoFormatContext^.streams[i].codec^.codec_type ) ) ); + {$endif} + if(VideoFormatContext^.streams[i]^.codec^.codec_type=CODEC_TYPE_VIDEO) then + begin + {$ifdef DebugDisplay} + writeln( 'FFMPEG debug, found CODEC_TYPE_VIDEO stream' ); + {$endif} + VideoStreamIndex:=i; + end + else + end; + except + // TODO : JB_Linux ... this is excepting at line 108... ( Was 111 previously.. so its prob todo with streams[i]^.codec .. + {$ifdef DebugDisplay} + writeln( 'FFMPEG error, finding video stream' ); + {$endif} + end; + + end; + end; + + if(VideoStreamIndex >= 0) then + begin + VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; + VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); + end + else + begin +{$ifdef DebugDisplay} + showmessage('found no video stream'); +{$ENDIF} + av_close_input_file(VideoFormatContext); + Exit; + end; + + if(VideoCodec<>Nil) then + begin + errnum:=avcodec_open(VideoCodecContext, VideoCodec); + end else begin +{$ifdef DebugDisplay} + showmessage('no matching codec found'); +{$ENDIF} + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(errnum >=0) then + begin +{$ifdef DebugDisplay} + showmessage('Found a matching Codec:'+#13#10#13#10+ + 'Width='+inttostr(VideoCodecContext^.width)+ + ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + 'Aspect: '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + '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; + end; + myBuffer:=Nil; + if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then + begin + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, + VideoCodecContext^.height)); + end; + if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, + VideoCodecContext^.width, VideoCodecContext^.height) + else begin +{$ifdef DebugDisplay} + showmessage('failed to allocate video buffer'); +{$endif} + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if errnum >=0 then + begin + VideoOpened:=True; + + TexX := VideoCodecContext^.width; + TexY := VideoCodecContext^.height; + dataX := Round(Power(2, Ceil(Log2(TexX)))); + dataY := Round(Power(2, Ceil(Log2(TexY)))); + SetLength(TexData,dataX*dataY*3); + // calculate some information for video display + VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; + if (VideoAspect = 0) then + VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height + else + VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; + if VideoAspect >= 4/3 then + begin + ScaledVideoWidth:=800.0; + ScaledVideoHeight:=800.0/VideoAspect; + end else + begin + ScaledVideoHeight:=600.0; + ScaledVideoWidth:=600.0*VideoAspect; + end; + VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; + // hack to get reasonable timebase for divx +{$ifdef DebugDisplay} + showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); +{$endif} + if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps + begin + VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; + while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; + VideoTimeBase:=1/VideoTimeBase; + end; +{$ifdef DebugDisplay} + showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); + if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then + showmessage('you are trying to play a rather large video'+#13#10+ + 'be prepared to experience some timing problems'); +{$endif} + end; + end; +end; + +procedure FFmpegClose; +begin + if VideoOpened then begin + av_free(myBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + SetLength(TexData,0); + VideoOpened:=False; + end; +end; + +procedure FFmpegTogglePause; +begin + if VideoPaused then VideoPaused:=False + else VideoPaused:=True; +end; + +procedure FFmpegSkip(Time: Single); +begin + VideoSkiptime:=Time; + if VideoSkipTime > 0 then begin + av_seek_frame(VideoFormatContext,-1,Floor((VideoSkipTime)*1500000),0); + VideoTime:=VideoSkipTime; + end; +end; + +procedure FFmpegGetFrame(Time: Extended); +var + FrameFinished: Integer; + AVPacket: TAVPacket; + errnum, x, y: Integer; + FrameDataPtr: PByteArray; + linesize: integer; + myTime: Extended; + DropFrame: Boolean; + droppedFrames: Integer; +const + FRAMEDROPCOUNT=3; +begin + if not VideoOpened then Exit; + if VideoPaused then Exit; + myTime:=Time+VideoSkipTime; + TimeDifference:=myTime-VideoTime; + DropFrame:=False; +{ showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +} + 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} +{ showmessage('not getting new frame'+#13#10+ + 'Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +} + Exit;// we don't need a new frame now + end; + VideoTime:=VideoTime+VideoTimeBase; + TimeDifference:=myTime-VideoTime; + if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then begin // skip frames +{$ifdef DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); +{$endif} +// showmessage('skipping frames'+#13#10+ +// 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ +// 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ +// 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); +// av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time*VideoTimeBase),0); +{ av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); + VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} + VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; + DropFrame:=True; + end; + + av_init_packet(@AVPacket); + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + begin + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, + AVPacket.data, AVPacket.size); + // release internal packet structure created by av_read_frame + av_free_packet(PAVPacket(@AVPacket)); + end; + if DropFrame then + for droppedFrames:=1 to FRAMEDROPCOUNT do begin + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + begin + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, + AVPacket.data, AVPacket.size); + // release internal packet structure created by av_read_frame + av_free_packet(PAVPacket(@AVPacket)); + end; + end; + + // if we did not get an new frame, there's nothing more to do + if Framefinished=0 then begin + GoldenRec.Spawn(220,15,1,16,0,-1,ColoredStar,$0000ff); + Exit; + end; + // otherwise we convert the pixeldata from YUV to RGB + errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); +//errnum:=1; + if errnum >=0 then begin + // copy RGB pixeldata to our TextureBuffer + // (line by line) + FrameDataPtr:=AVFrameRGB^.data[0]; + linesize:=AVFrameRGB^.linesize[0]; + for y:=0 to TexY-1 do begin + System.Move(FrameDataPtr[y*linesize],TexData[3*y*dataX],linesize); + end; + + // generate opengl texture out of whatever we got + glBindTexture(GL_TEXTURE_2D, VideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, TexData); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +{$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); +{$endif} + + end; +end; + +procedure FFmpegDrawGL(Screen: integer); +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 VideoOpened then Exit; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, VideoTex); + glbegin(gl_quads); + glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{$ifdef Info} + if VideoSkipTime+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; + +end. -- cgit v1.2.3 From 4d693075a4b5078a9e08430d003e2bdb918b68c2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 8 Oct 2007 02:02:07 +0000 Subject: trying to fix linux runtime errors with database ( Stats screen ) and Song Selection screen ( now back to kina working ) Testing Fisheye Links (please ignore): jira#USDX-1 sf#1790165 build#USDX-DELPHI-26 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@469 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDataBase.pas | 175 +++++++++++++++++++++++++++------------- 1 file changed, 119 insertions(+), 56 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index deee85c0..bacb0d98 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -7,7 +7,8 @@ interface {$ENDIF} -uses USongs, SQLiteTable3; +uses USongs, + SQLiteTable3; //-------------------- //DataBaseSystem - Class including all DB Methods @@ -37,6 +38,7 @@ type private ScoreDB: TSqliteDatabase; sFilename: string; + public @@ -60,29 +62,44 @@ implementation uses IniFiles, SysUtils; +const + cUS_Scores = 'us_scores'; + cUS_Songs = 'us_songs'; + //-------------------- //Create - Opens Database and Create Tables if not Exist //-------------------- Procedure TDataBaseSystem.Init(const Filename: string); begin + writeln( 'TDataBaseSystem.Init' ); + //Open Database - ScoreDB := TSqliteDatabase.Create(Filename); + ScoreDB := TSqliteDatabase.Create( Filename ); sFilename := Filename; try - //Look for Tables => When not exist Create them - if not ScoreDB.TableExists('US_Scores') then - ScoreDB.execsql('CREATE TABLE `US_Scores` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + //Look for Tables => When not exist Create them + if not ScoreDB.TableExists( cUS_Scores ) then + begin + ScoreDB.execsql('CREATE TABLE `'+cUS_Scores+'` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + writeln( 'TDataBaseSystem.Init - CREATED US_Scores' ); + end; - if not ScoreDB.TableExists('US_Songs') then - ScoreDB.execsql('CREATE TABLE `US_Songs` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); - //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper - {if not ScoreDB.TableExists('US_SongCache') then - ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} + if not ScoreDB.TableExists( cUS_Songs ) then + begin + ScoreDB.execsql('CREATE TABLE `'+cUS_Songs+'` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); + writeln( 'TDataBaseSystem.Init - CREATED US_Songs' ); + end; + + //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper + {if not ScoreDB.TableExists('US_SongCache') then + ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} finally + writeln( cUS_Songs +' Exist : ' + inttostr( integer(ScoreDB.TableExists( cUS_Songs )) ) ); + writeln( cUS_Scores +' Exist : ' + inttostr( integer(ScoreDB.TableExists( cUS_Scores )) ) ); //ScoreDB.Free; end; @@ -93,7 +110,9 @@ end; //-------------------- Destructor TDataBaseSystem.Free; begin - ScoreDB.Free; + writeln( 'TDataBaseSystem.Free' ); + + freeandnil( ScoreDB ); end; //-------------------- @@ -104,37 +123,44 @@ var TableData: TSqliteTable; Dif: Byte; begin + if not assigned( ScoreDB ) then + exit; + + //ScoreDB := TSqliteDatabase.Create(sFilename); try - try - //Search Song in DB - TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `us_scores` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); - //Empty Old Scores - SetLength (Song.Score[0], 0); - SetLength (Song.Score[1], 0); - SetLength (Song.Score[2], 0); - - while not TableData.Eof do//Go through all Entrys - begin//Add one Entry to Array - Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); - if (Dif>=0) AND (Dif<=2) then - begin - SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); - - Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); - Song.Score[Dif, high(Song.Score[Dif])].Score:= StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + try + //Search Song in DB + TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `'+cUS_Scores+'` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); + + //Empty Old Scores + SetLength (Song.Score[0], 0); + SetLength (Song.Score[1], 0); + SetLength (Song.Score[2], 0); + + while not TableData.Eof do//Go through all Entrys + begin//Add one Entry to Array + Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); + if (Dif>=0) AND (Dif<=2) then + begin + SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); + + Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); + Song.Score[Dif, high(Song.Score[Dif])].Score := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + end; + TableData.Next; + + end; // While not TableData.EOF + + except //Im Fehlerfall + for Dif := 0 to 2 do + begin + SetLength(Song.Score[Dif], 1); + Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; + end; end; - TableData.Next; - end; - - except //Im Fehlerfall - for Dif := 0 to 2 do - begin - SetLength(Song.Score[Dif], 1); - Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; - end; - end; - finally + + finally // Try Finally //ScoreDb.Free; end; end; @@ -147,27 +173,30 @@ var ID: Integer; TableData: TSqliteTable; begin + if not assigned( ScoreDB ) then + exit; + //ScoreDB := TSqliteDatabase.Create(sFilename); try //Prevent 0 Scores from being added if (Score > 0) then begin - ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `'+cUS_Songs+'` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); if ID = 0 then //Song doesn't exist -> Create begin - ScoreDB.ExecSQL ('INSERT INTO `US_Songs` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); + ScoreDB.ExecSQL ('INSERT INTO `'+cUS_Songs+'` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); if ID = 0 then //Could not Create Table exit; end; //Create new Entry - ScoreDB.ExecSQL('INSERT INTO `US_Scores` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); + ScoreDB.ExecSQL('INSERT INTO `'+cUS_Scores+'` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); //Delete Last Position when there are more than 5 Entrys - if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `US_Scores` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then + if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `'+cUS_Scores+'` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then begin - TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); + TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `'+cUS_Scores+'` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); end; @@ -182,9 +211,12 @@ end; //-------------------- procedure TDataBaseSystem.WriteScore(var Song: TSong); begin + if not assigned( ScoreDB ) then + exit; + try //Increase TimesPlayed - ScoreDB.ExecSQL ('UPDATE `us_songs` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); + ScoreDB.ExecSQL ('UPDATE `'+cUS_Songs+'` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); except end; @@ -205,6 +237,9 @@ var begin Result := False; + if not assigned( ScoreDB ) then + exit; + if (Length(Stats) < Count) then Exit; @@ -212,10 +247,10 @@ begin //Create Query Case Typ of - 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `US_Scores` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; - 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `US_Scores` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; - 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `US_Songs` ORDER BY `TimesPlayed`'; - 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `US_Songs` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; + 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `'+cUS_Scores+'` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; + 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `'+cUS_Scores+'` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; + 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `'+cUS_Scores+'` ORDER BY `TimesPlayed`'; + 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `'+cUS_Scores+'` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; end; //Add Order Direction @@ -284,15 +319,43 @@ end; Function TDataBaseSystem.GetTotalEntrys(const Typ: Byte): Cardinal; var Query: String; begin - //Create Query - Case Typ of - 0: Query := 'SELECT COUNT(`SongID`) FROM `US_Scores`;'; - 1: Query := 'SELECT COUNT(DISTINCT `Player`) FROM `US_Scores`;'; - 2: Query := 'SELECT COUNT(`ID`) FROM `US_Songs`;'; - 3: Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `US_Songs`;'; + if not assigned( ScoreDB ) then + exit; + try + //Create Query + Case Typ of + 0: begin + Query := 'SELECT COUNT(`SongID`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Scores ) then + exit; + end; + 1: begin + Query := 'SELECT COUNT(DISTINCT `Player`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Scores ) then + exit; + end; + 2: begin + Query := 'SELECT COUNT(`ID`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Songs ) then + exit; + end; + 3: begin + Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `'+cUS_Songs+'`;'; + if not ScoreDB.TableExists( cUS_Songs ) then + exit; + end; + end; + + Result := ScoreDB.GetTableValue(Query); + except + // TODO : JB_Linux - Why do we get these exceptions on linux !! + on E:ESQLiteException DO // used to handle : Could not retrieve data "SELECT COUNT(`ID`) FROM `US_Songs`;" : SQL logic error or missing database + // however, we should pre-empt this error... and make sure the database DOES exist. + begin + result := 0; + end; end; - Result := ScoreDB.GetTableValue(Query); end; end. -- cgit v1.2.3 From ef07574805b0fb247cfa91f0e6bbb234c0dbd22a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 8 Oct 2007 06:45:19 +0000 Subject: minor changes to faciliate ffmpeg audio playback jira#USDX-123 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@470 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 107 +++++++++++++++++++++++++++++++++++++++++-- Game/Code/Classes/UTime.pas | 11 +++++ 2 files changed, 113 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index b3729e69..bdd0be83 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -41,8 +41,48 @@ type Handle : hStream; end; + IAudioPlayback = Interface + procedure InitializePlayback; + + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + + function Open(Name: string): boolean; // true if succeed + + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; - TMusic = class + procedure Rewind; + procedure MoveTo(Time: real); + procedure Close; + + function Finished: boolean; + function Length: real; + function Position: real; + + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal); + end; + + + TMusic = class( TInterfacedObject, IAudioPlayback ) private BassStart: hStream; // Wait, I've replaced this with BASS BassBack: hStream; // It has almost all features we need @@ -59,6 +99,8 @@ type CustomSounds: array of TCustomSoundEntry; + function FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; + Loaded: boolean; Loop: boolean; public @@ -101,7 +143,6 @@ type //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal); - end; const @@ -202,6 +243,11 @@ uses {$IFDEF FPC} lclintf, {$ENDIF} + + avcodec, + avformat, + avutil, + UGraphic, URecord, UFiles, @@ -265,7 +311,8 @@ begin // LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4); + Log.BenchmarkEnd(4); + Log.LogBenchmark('--> Loading Sounds', 4); end; procedure TMusic.InitializeRecord; @@ -663,14 +710,19 @@ function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; var L: Integer; begin - if FileExists(Name) then begin + if FileExists(Name) then + begin Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); try {$IFDEF useBASS} // TODO : jb_linux replace with something other than bass hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + {$ELSE} + hStream := FFMPeg_StreamCreateFile(False, pchar(Name) ); {$ENDIF} + + //Add CustomSound L := High(CustomSounds) + 1; SetLength (CustomSounds, L + 1); @@ -679,7 +731,9 @@ begin except Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); end; - end else begin + end + else + begin Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); exit; end; @@ -735,4 +789,47 @@ begin end; +{* + +Sorry guys... this is my mess :( +Im going to try and get ffmpeg to handle audio playback ( at least for linux ) +and Im going to implement it nicly along side BASS, in TMusic ( where I can ) + +http://www.dranger.com/ffmpeg/ffmpeg.html +http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + +http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*} +function TMusic.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; +var + lFormatCtx : PAVFormatContext; +begin + +(* + if(SDL_OpenAudio(&wanted_spec, &spec) < 0) + begin + fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); + writeln( 'SDL_OpenAudio' ); + exit; + end; +*) + +(* + if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) + begin + writeln( 'Unable to open file '+ aFileName ); + exit; + end; + + // Retrieve stream information + if ( av_find_stream_info(pFormatCtx) < 0 ) + begin + writeln( 'Unable to Retrieve stream information' ); + exit; + end; +*) + +end; + end. diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index d06628cc..c197a70f 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -43,6 +43,17 @@ uses // who knows how fast or slow that function is ! // but this gets a compile for now .. :) +(* +msec( ) +{ + struct timeval tv; + gettimeofday( &tv, NULL ); + return (int64_t)tv.tv_sec * (int64_t)1000000 + (int64_t)tv.tv_usec; +} + +*) + + constructor TTime.Create; begin CountSkipTimeSet; -- cgit v1.2.3 From 174244a5ddf10da145779f6fe0ad1c5bc398fa6a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 8 Oct 2007 09:08:17 +0000 Subject: fixed bad build build#USDX-DELPHI-31 oops... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@473 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 7 ++++--- Game/Code/Classes/URecord.pas | 3 ++- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index bdd0be83..3c43615b 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -97,12 +97,12 @@ type //Custom Sounds CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; function FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; - Loaded: boolean; - Loop: boolean; public Bass: hStream; procedure InitializePlayback; @@ -670,7 +670,8 @@ begin {$IFDEF useBASS} // TODO : jb_linux replace with something other than bass - if not BASS_RecordInit(RecordI) then begin + if not BASS_RecordInit(RecordI) then + begin Error := BASS_ErrorGetCode; ErrorMsg := IntToStr(Error); diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index d22e20d3..b553504d 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -76,6 +76,7 @@ var Recording: TRecord; implementation + uses UMain; procedure TSound.ProcessNewBuffer; @@ -308,7 +309,7 @@ begin Repeat Inc(No) Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - + //Set Description Descr := Descr + ' (' + InttoStr(No) + ')'; end; -- cgit v1.2.3 From 621bfb05407a169f6511f5b115d0622e5ec8bdd5 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 10 Oct 2007 17:50:05 +0000 Subject: Added Hook and Service Class for new Plugin System to Trunc Added Core and CoreModule. That maybe will be used for new Core management. Core needs many code to write Some Info to Plugin SDK added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@497 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 278 ++++++++++++++++++++++++++++ Game/Code/Classes/UCoreModule.pas | 105 +++++++++++ Game/Code/Classes/UHooks.pas | 375 ++++++++++++++++++++++++++++++++++++++ Game/Code/Classes/UModules.pas | 20 ++ Game/Code/Classes/UServices.pas | 312 +++++++++++++++++++++++++++++++ Game/Code/Classes/USingScores.pas | 1 - 6 files changed, 1090 insertions(+), 1 deletion(-) create mode 100644 Game/Code/Classes/UCore.pas create mode 100644 Game/Code/Classes/UCoreModule.pas create mode 100644 Game/Code/Classes/UHooks.pas create mode 100644 Game/Code/Classes/UModules.pas create mode 100644 Game/Code/Classes/UServices.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas new file mode 100644 index 00000000..744fabe2 --- /dev/null +++ b/Game/Code/Classes/UCore.pas @@ -0,0 +1,278 @@ +unit UCore; + +interface +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 ;) +*********************} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +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; + hLoadTextures: THandle; + hExitQuery: THandle; + hExit: THandle; + hDebug: THandle; + hError: THandle; + sgiveError: THandle; + sgiveDebug: THandle; + + Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + + //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 + + CurExecuted: Integer; //ID of Plugin or Module curently Executed + + Name: String; //Name of this Application + Version: LongWord; //Version of this ". For Info Look PluginDefs Functions + + //--------------- + //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; + + //-------------- + // Hook and Service Procs: + //-------------- + Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + end; + +var + Core: TCore; + +implementation +{$IFDEF win32} +uses Windows; +{$ENDIF} + +//------------- +// Create - Creates Class + Hook and Service Manager +//------------- +Constructor TCore.Create(const cName: String; const cVersion: LongWord); +begin + Name := cName; + Version := cVersion; + CurExecuted := 0; + + Hooks := THookManager.Create(50); + Services := TServiceManager.Create; +end; + +//------------- +//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown +//------------- +Procedure TCore.Run; +var + noError: Boolean; +begin + //Get Modules + Try + noError := GetModules; + Except + noError := False; + end; + + //Loading + if (noError) then + begin + Try + noError := Load; + Except + noError := False; + end; + end + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar(''))); +end; + +//------------- +//Called one Time per Frame +//------------- +Function TCore.MainLoop: Boolean; +begin + Result := True; + +end; + +//------------- +//Function Get all Modules and Creates them +//------------- +Function TCore.GetModules: Boolean; +var + I: Integer; +begin + For I := 0 to high(Modules) do + begin + Modules[I].NeedsDeInit := False; + Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; + Modules[I].Module.Info(@Modules[I].Info); + end; +end; + +//------------- +//Loads Core and all Modules +//------------- +Function TCore.Load: Boolean; +var + I: Integer; +begin + Result := LoadCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + Result := Modules[I].Module.Load; + Inc(I); + end; +end; + +//------------- +//Inits Core and all Modules +//------------- +Function TCore.Init: Boolean; +begin + Result := InitCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + Result := Modules[I].Module.Init; + Inc(I); + end; +end; + +//------------- +//DeInits Core and all Modules +//------------- +Function TCore.DeInit: Boolean; + + label Continue; +begin + I := High(CORE_MODULES_TO_LOAD); + + Continue: + Try + While (I >= 0) do + begin + If (Modules[I].NeedsDeInit) then + Modules[I].Module.DeInit; + + Dec(I); + end; + Except + + GoTo Continue; + end; + + DeInitCore; +end; + +//------------- +//Load the Core +//------------- +Function TCore.LoadCore: Boolean; +begin + hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); + hMainLoop := Hooks.AddEvent('Core/MainLoop'); + 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'); + sReportDebug := Services.AddService('Core/ReportDebug'); +end; + +//------------- +//Init the Core +//------------- +Function TCore.InitCore: Boolean; +begin + //Dont Init s.th. atm. +end; + +//------------- +//DeInit the Core +//------------- +Function TCore.DeInitCore: Boolean; +begin + + + // to-do : write TService-/HookManager.Free and call it here +end; + +//------------- +//Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +Function TCore.ShowMessage(wParam, lParam: DWord): integer; +var Params: Cardinal; +begin + Result := -1; + + {$IFDEF win32} + If (ptr(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; + + //Anzeigen: + Result := Messagebox(0, ptr(lParam), PChar(Name), Params); + end; + {$ENDIF} + + // to-do : write ShowMessage for other OSes +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas new file mode 100644 index 00000000..4d36f925 --- /dev/null +++ b/Game/Code/Classes/UCoreModule.pas @@ -0,0 +1,105 @@ +unit UCoreModule; + +interface +{********************* + TCoreModule + Dummy Class that has Methods that will be called from Core + In the Best case every Piece of this Software is a Module +*********************} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +type + PModuleInfo = ^TModuleInfo; + TModuleInfo = record + Name: String; + Version: LongWord; + Description: String; + end; + + TCoreModule = class + public + //Function that gives some Infos about the Module to the Core + Procedure Info(const pInfo: PModuleInfo); + + //Is Called on Loading. + //In this Method only Events and Services should be created + //to offer them to other Modules or Plugins during the Init process + //If False is Returned this will cause a Forced Exit + Function Load: Boolean; virtual; + + //Is Called on Init Process + //In this Method you can Hook some Events and Create + Init + //your Classes, Variables etc. + //If False is Returned this will cause a Forced Exit + Function Init: Boolean; virtual; + + //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing + //If False is Returned this will cause a Forced Exit + Function MainLoop: Boolean; virtual; + + //Is Called if this Module has been Inited and there is a Exit. + //Deinit is in backwards Initing Order + //If False is Returned this will cause a Forced Exit + Procedure DeInit; virtual; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TCoreModule.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'Not Set'; + pInfo^.Version := 0; + pInfo^.Description := 'Not Set'; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Load: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Init: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.MainLoop: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TCoreModule.DeInit; +begin + //Dummy ftw!! +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas new file mode 100644 index 00000000..c73ccbbb --- /dev/null +++ b/Game/Code/Classes/UHooks.pas @@ -0,0 +1,375 @@ +unit UHooks; + +{********************* + THookManager + Class for saving, managing and calling of Hooks. + Saves all hookable events and their subscribers +*********************} +interface +uses uPluginDefs, SysUtils, WINDOWS; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + //Record that saves info from Subscriber + PSubscriberInfo = ^TSubscriberInfo; + TSubscriberInfo = record + Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) + Next: PSubscriberInfo; //Pointer to next Item in HookChain + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to Hook an Event with a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Hook); //Proc that will be called on Event + True: (ProcOfClass: TUS_Hook_of_Object); + end; + + TEventInfo = record + Name: String[60]; //Name of Event + FirstSubscriber: PSubscriberInfo; //First subscriber in chain + LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + end; + + THookManager = class + private + Events: array of TEventInfo; + SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + public + constructor Create(const SpacetoAllocate: Word); + + Function AddEvent (const EventName: PChar): THandle; + Function DelEvent (hEvent: THandle): Integer; + + Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + Function DelSubscriber (const hSubscriber: THandle): Integer; + + Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; + Function EventExists (const EventName: PChar): Integer; + end; + +function HookTest(wParam, lParam: DWord): integer; stdcall; +function HookTest2(wParam, lParam: DWord): integer; stdcall; + +var + HookManager: THookManager; + +implementation + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + For I := 0 to SpacetoAllocate do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + WriteLn('HookManager: Succesful Created.'); + {$ENDIF} +end; + +//------------ +// AddEvent - Adds an Event and return the Events Handle or 0 on Failure +//------------ +Function THookManager.AddEvent (const EventName: PChar): THandle; +var I: Integer; +begin + Result := 0; + + if (EventExists(EventName) = 0) then + begin + If (SpaceinEvents > 0) then + begin + //There is already Space available + //Go Search it! + For I := 0 to High(Events) do + If (Events[I].Name[1] = chr(0)) then + begin //Found Space + Result := I; + Dec(SpaceinEvents); + Break; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); + {$ENDIF} + end + else + begin //There is no Space => Go make some! + Result := Length(Events); + SetLength(Events, Result + 1); + end; + + //Set Events Data + Events[Result].Name := EventName; + Events[Result].FirstSubscriber := nil; + Events[Result].LastSubscriber := nil; + + //Handle is Index + 1 + Inc(Result); + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + WriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); + {$ENDIF} +end; + +//------------ +// DelEvent - Deletes an Event by Handle Returns False on Failure +//------------ +Function THookManager.DelEvent (hEvent: THandle): Integer; +var + Cur, Last: PSubscriberInfo; +begin + hEvent := hEvent - 1; //Arrayindex is Handle - 1 + Result := -1; + + + If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then + begin //Event exists + //Free the Space for all Subscribers + Cur := Events[hEvent].FirstSubscriber; + + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TSubscriberInfo)); + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); + {$ENDIF} + + //Free the Event + Events[hEvent].Name[1] := chr(0); + Inc(SpaceinEvents); //There is one more space for new events + end + + {$IFDEF DEBUG} + else + WriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); + {$ENDIF} +end; + +//------------ +// AddSubscriber - Adds an Subscriber to the Event by Name +// Returns Handle of the Subscribtion or 0 on Failure +//------------ +Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +var + EventHandle: THandle; + EventIndex: Cardinal; + Cur: PSubscriberInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + EventHandle := EventExists(EventName); + + If (EventHandle <> 0) then + begin + EventIndex := EventHandle - 1; + + //Get Memory + GetMem(Cur, SizeOf(TSubscriberInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID + If (Events[EventIndex].LastSubscriber = nil) then + begin + If (Events[EventIndex].FirstSubscriber = nil) then + begin + Result := (EventHandle SHL 16); + Events[EventIndex].FirstSubscriber := Cur; + end + Else + begin + Result := Events[EventIndex].FirstSubscriber.Self + 1; + end; + end + Else + begin + Result := Events[EventIndex].LastSubscriber.Self + 1; + Events[EventIndex].LastSubscriber.Next := Cur; + end; + + Cur.Self := Result; + + //Add to Chain + Events[EventIndex].LastSubscriber := Cur; + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''); + {$ENDIF} + end; + end; +end; + +//------------ +// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure +//------------ +Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; +var + EventIndex: Cardinal; + Cur, Last: PSubscriberInfo; +begin + Result := -1; + EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; + + //Existing Event ? + If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then + begin + Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription + + //Search for Subscription + Cur := Events[EventIndex].FirstSubscriber; + Last := nil; + + //go through the chain ... + While (Cur <> nil) do + begin + If (Cur.Self = hSubscriber) then + begin //Found Subscription we searched for + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); + + {$IFDEF DEBUG} + WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); + {$ENDIF} + + //Set Result and Break the Loop + Result := 0; + Break; + end; + + Last := Cur; + Cur := Cur.Next; + end; + + end; +end; + + +//------------ +// CallEventChain - Calls the Chain of a specified EventHandle +// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End +//------------ +Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; +var + EventIndex: Cardinal; + Cur: PSubscriberInfo; +begin + Result := -1; + EventIndex := hEvent - 1; + + If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then + begin //Existing Event + //Start calling the Chain !!!11 + Cur := Events[EventIndex].FirstSubscriber; + Result := 0; + //Call Hooks until the Chain is at the End or breaked + While ((Cur <> nil) AND (Result = 0)) do + begin + if (Cur.isClass) then + Result := Cur.ProcOfClass(wParam, lParam) + else + Result := Cur.Proc(wParam, lParam); + + Cur := Cur.Next; + end; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); + {$ENDIF} +end; + +//------------ +// EventExists - Returns non Zero if an Event with the given Name exists +//------------ +Function THookManager.EventExists (const EventName: PChar): Integer; +var + I: Integer; + Name: String[60]; +begin + Result := 0; + //If (Length(EventName) < + Name := String(EventName); + + //Sure not to search for empty space + If (Name[1] <> chr(0)) then + begin + //Search for Event + For I := 0 to High(Events) do + If (Events[I].Name = Name) then + begin //Event found + Result := I + 1; + Break; + end; + end; +end; + + +function HookTest(wParam, lParam: DWord): integer; stdcall; +var Test: String[60]; +var T2: String; +begin + Messagebox(0, 'Test', 'test', MB_ICONWARNING or MB_OK); + + Result := 0; //Don't break the chain +end; + +function HookTest2(wParam, lParam: DWord): integer; stdcall; +begin + //Showmessage(String(PCHAR(Ptr(lParam))); + Messagebox(0, Ptr(lParam), 'test', MB_ICONWARNING or MB_OK); + + Result := 0; //Don't break the chain +end; + +end. diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas new file mode 100644 index 00000000..e8e759ff --- /dev/null +++ b/Game/Code/Classes/UModules.pas @@ -0,0 +1,20 @@ +unit UModules; + +interface +{********************* + UModules + Unit Contains all used Modules in its uses clausel + and a const with an array of all Modules to load +*********************} + +uses + UCoreModule; + +const + CORE_MODULES_TO_LOAD: Array[0..0] of cCoreModule = ( + TCoreModule //Remove this later, just a dummy + ); + +implementation + +end. \ No newline at end of file diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas new file mode 100644 index 00000000..fce81bd8 --- /dev/null +++ b/Game/Code/Classes/UServices.pas @@ -0,0 +1,312 @@ +unit UServices; + +interface +uses uPluginDefs, SysUtils; +{********************* + TServiceManager + Class for saving, managing and calling of Services. + Saves all Services and their Procs +*********************} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TServiceName = String[60]; + PServiceInfo = ^TServiceInfo; + TServiceInfo = record + Self: THandle; //Handle of this Service + Hash: Integer; //4 Bit Hash of the Services Name + Name: TServiceName; //Name of this Service + + Owner: Integer; //If > 0 [DLLMan Pluginindex + 1]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + + Next: PServiceInfo; //Pointer to the Next Service in teh list + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to offer a Service from a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Service); //Proc that will be called on Event + True: (ProcOfClass: TUS_Service_of_Object); + end; + + TServiceManager = class + private + //Managing Service List + FirstService: PServiceInfo; + LastService: PServiceInfo; + + //Some Speed improvement by caching the last 4 called Services + //Most of the time a Service is called multiple times + ServiceCache: Array[0..3] of PServiceInfo; + NextCacheItem: Byte; + + //Next Service added gets this Handle: + NextHandle: THandle; + public + Constructor Create; + + Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; + Function DelService(const hService: THandle): integer; + + Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Succesful created!'); + {$ENDIF} +end; + +//------------ +// Function Creates a new Service and Returns the Services Handle, +// 0 on Failure. (Name already exists) +//------------ +Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; +var + Cur: PServiceInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + If (ServiceExists(ServiceName) = 0) then + begin //There is a Proc and the Service does not already exist + //Ok Add it! + + //Get Memory + GetMem(Cur, SizeOf(TServiceInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + Cur.Self := NextHandle; + //Zero Name + Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + Cur.Name := String(ServiceName); + Cur.Hash := NametoHash(Cur.Name); + + //Add Service to the List + If (FirstService = nil) then + FirstService := Cur; + + If (LastService <> nil) then + LastService.Next := Cur; + + LastService := Cur; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else WriteLn('ServiceManager: Try to readd Service: ' + ServiceName); + {$ENDIF} + end; +end; + +//------------ +// Function Destroys a Service, 0 on success, not 0 on Failure +//------------ +Function TServiceManager.DelService(const hService: THandle): integer; +var + Last, Cur: PServiceInfo; + I: Integer; +begin + Result := -1; + + Last := nil; + Cur := FirstService; + + //Search for Service to Delete + While (Cur <> nil) do + begin + If (Cur.Self = hService) then + begin //Found Service => Delete it + + //Delete from List + If (Last = nil) then //Found first Service + FirstService := Cur.Next + Else //Service behind the first + Last.Next := Cur.Next; + + //IF this is the LastService, correct LastService + If (Cur = LastService) then + LastService := Last; + + //Search for Service in Cache and delete it if found + For I := 0 to High(ServiceCache) do + If (ServiceCache[I] = Cur) then + begin + ServiceCache[I] := nil; + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Removed Service succesful: ' + Cur.Name); + {$ENDIF} + + //Free Memory + Freemem(Cur, SizeOf(TServiceInfo)); + + //Break the Loop + Break; + end; + + //Go to Next Service + Last := Cur; + Cur := Cur.Next; + end; +end; + +//------------ +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//------------ +Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; +var + SExists: Integer; + Service: PServiceInfo; +begin + Result := SERVICE_NOT_FOUND; + SExists := ServiceExists(ServiceName); + If (SExists <> 0) then + begin + Service := ptr(SExists); + If (Service.isClass) then + //Use Proc of Class + Result := Service.ProcOfClass(wParam, lParam) + Else + //Use normal Proc + Result := Service.Proc(wParam, lParam); + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} + + Mov EDX, ServiceName {Save Address of String that should be "Hashed"} + + Mov EAX, [EDX] + + @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} + + LOOP @FoldLoop {Fold again if there are Chars Left} +end; + + +//------------ +// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 +//------------ +Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; +var + Name: TServiceName; + Hash: Integer; + Cur: PServiceInfo; + I: Byte; +begin + Result := 0; + // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) + //Zero Name: + Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + //Add Service Name + Name := String(ServiceName); + Hash := NametoHash(Name); + + //First of all Look for the Service in Cache + For I := 0 to High(ServiceCache) do + begin + If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then + begin + If (ServiceCache[I].Name = Name) then + begin //Found Service in Cache + Result := Integer(ServiceCache[I]); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); + {$ENDIF} + + Break; + end; + end; + end; + + If (Result = 0) then + begin + Cur := FirstService; + While (Cur <> nil) do + begin + If (Cur.Hash = Hash) then + begin + If (Cur.Name = Name) then + begin //Found the Service + Result := Integer(Cur); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in List: ''' + ServiceName + ''''); + {$ENDIF} + + //Add to Cache + ServiceCache[NextCacheItem] := Cur; + NextCacheItem := (NextCacheItem + 1) AND 3; + Break; + end; + end; + + Cur := Cur.Next; + end; + end; +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 7625c17c..11f1f07d 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -374,7 +374,6 @@ end; Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); var Cur: PScorePopUp; begin - Log.LogError('Spawn PopUp: Score: ' + InttoStr(Score)); if (PlayerIndex < PlayerCount) then begin //Get Memory and Add Data -- cgit v1.2.3 From 2f80e3be339f528bd0c7ef54db8ff7cc641883e3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 10 Oct 2007 18:07:01 +0000 Subject: Fixed some Bugs from Previous Commit git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@498 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 744fabe2..990ee7ab 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -31,8 +31,8 @@ type hExit: THandle; hDebug: THandle; hError: THandle; - sgiveError: THandle; - sgiveDebug: THandle; + sReportError: THandle; + sReportDebug: THandle; Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; @@ -81,8 +81,8 @@ type // Hook and Service Procs: //-------------- Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + {Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)} end; var @@ -178,6 +178,8 @@ end; //Inits Core and all Modules //------------- Function TCore.Init: Boolean; +var + I: Integer; begin Result := InitCore; @@ -193,8 +195,9 @@ end; //DeInits Core and all Modules //------------- Function TCore.DeInit: Boolean; - - label Continue; +var + I: Integer; +label Continue; begin I := High(CORE_MODULES_TO_LOAD); @@ -209,8 +212,10 @@ begin end; Except - GoTo Continue; + end; + If (I >= 0) then + GoTo Continue; DeInitCore; end; -- cgit v1.2.3 From d123263213fba448d5695df35660f7de4cbed433 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 11 Oct 2007 08:11:47 +0000 Subject: modified UTime to utilise SDL timer... this allows for reliable cross platform timers. Tested working on linux. Modified UVideo and screens to get Video playback working on linux currently only video stream... no audio.. but I Will be working towards this, for all audio playback ( at least for linux ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@501 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 16 ++- Game/Code/Classes/UTime.pas | 142 +++++++++++++----------- Game/Code/Classes/UVideo.pas | 258 ++++++++++++++++++++++++++++++------------- 3 files changed, 273 insertions(+), 143 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index aa4bc639..41676bf3 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -139,7 +139,11 @@ procedure MainLoop; var Delay: integer; begin + Delay := 0; SDL_EnableKeyRepeat(125, 125); + + + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. While not Done do Begin // joypad @@ -158,16 +162,26 @@ begin // delay CountMidTime; + + {$IFDEF DebugDisplay} + Writeln( 'TimeMid : '+ inttostr(trunc(TimeMid)) ); + {$ENDIF} + // if 1000*TimeMid > 100 then beep; Delay := Floor(1000 / 100 - 1000 * TimeMid); + {$IFDEF DebugDisplay} + Writeln( 'Delay ms : '+ inttostr(Delay) ); + {$ENDIF} + if Delay >= 1 then SDL_Delay(Delay); // dynamic, maximum is 100 fps CountSkipTime; // reinitialization of graphics - if Restart then begin + if Restart then + begin Reinitialize3D; Restart := false; end; diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index c197a70f..edd65b7e 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -6,6 +6,9 @@ interface {$MODE Delphi} {$ENDIF} +{$DEFINE SDLTimer} +{$UNDEF DebugDisplay} + type TTime = class constructor Create; @@ -15,7 +18,6 @@ type procedure CountSkipTimeSet; procedure CountSkipTime; procedure CountMidTime; -procedure TimeSleep(ms: real); var USTime: TTime; @@ -36,21 +38,22 @@ uses libc, time, {$ENDIF} + sysutils, + {$IFDEF SDLTimer} + sdl, + {$ENDIF} ucommon; - - -// -- ON Linux it MAY Be better to use ... clock_gettime() instead of CurrentSec100OfDay -// who knows how fast or slow that function is ! -// but this gets a compile for now .. :) + +const + cSDLCorrectionRatio = 1000; (* -msec( ) -{ - struct timeval tv; - gettimeofday( &tv, NULL ); - return (int64_t)tv.tv_sec * (int64_t)1000000 + (int64_t)tv.tv_usec; -} +BEST Option now ( after discussion with whiteshark ) seems to be to use SDL +timer functions... +SDL_delay +SDL_GetTicks +http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7 *) @@ -59,86 +62,99 @@ begin CountSkipTimeSet; end; + procedure CountSkipTimeSet; begin - {$IFDEF win32} - QueryPerformanceFrequency(TimeFreq); - QueryPerformanceCounter(TimeNew); + {$IFDEF SDLTimer} + TimeNew := SDL_GetTicks(); // / cSDLCorrectionRatio + TimeFreq := 0; {$ELSE} - TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at - TimeFreq := 0; + {$IFDEF win32} + QueryPerformanceFrequency(TimeFreq); + QueryPerformanceCounter(TimeNew); + {$ELSE} + TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + TimeFreq := 0; + {$ENDIF} + {$ENDIF} + + {$IFDEF DebugDisplay} + Writeln( 'CountSkipTimeSet : ' + inttostr(trunc(TimeNew)) ); {$ENDIF} end; + procedure CountSkipTime; begin TimeOld := TimeNew; - {$IFDEF win32} - QueryPerformanceCounter(TimeNew); + {$IFDEF SDLTimer} + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; {$ELSE} - TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + {$IFDEF win32} + QueryPerformanceCounter(TimeNew); + + if ( TimeNew-TimeOld > 0 ) AND + ( TimeFreq > 0 ) THEN + begin + TimeSkip := (TimeNew-TimeOld)/TimeFreq; + end; + + {$ELSE} + TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at + TimeSkip := (TimeNew-TimeOld); + {$ENDIF} {$ENDIF} - - if ( TimeNew-TimeOld > 0 ) AND - ( TimeFreq > 0 ) THEN - begin - TimeSkip := (TimeNew-TimeOld)/TimeFreq; - end; -end; -procedure CountMidTime; -begin - {$IFDEF win32} - QueryPerformanceCounter(TimeMidTemp); - TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; - {$ELSE} - TimeMidTemp := CurrentSec100OfDay(); - TimeMid := (TimeMidTemp-TimeNew); // TODO - JB_Linux will prob need looking at + {$IFDEF DebugDisplay} + Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); + Writeln( 'CountSkipTime : ' + inttostr(trunc(TimeSkip)) ); {$ENDIF} end; -procedure TimeSleep(ms: real); -var - TimeStart: int64; - TimeHalf: int64; - Time: real; - Stop: boolean; + +procedure CountMidTime; begin - {$IFDEF win32} - QueryPerformanceCounter(TimeStart); + {$IFDEF SDLTimer} + TimeMidTemp := SDL_GetTicks(); + TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; {$ELSE} - TimeStart := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at - {$ENDIF} - - - Stop := false; - while (not Stop) do - begin {$IFDEF win32} - QueryPerformanceCounter(TimeHalf); - Time := 1000 * (TimeHalf-TimeStart)/TimeFreq; + QueryPerformanceCounter(TimeMidTemp); + TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; {$ELSE} - TimeHalf := CurrentSec100OfDay(); - Time := 1000 * (TimeHalf-TimeStart); // TODO - JB_Linux will prob need looking at + TimeMidTemp := CurrentSec100OfDay(); + TimeMid := (TimeMidTemp-TimeNew); // TODO - JB_Linux will prob need looking at {$ENDIF} + {$ENDIF} - if Time > ms then - Stop := true; - end; - + {$IFDEF DebugDisplay} + Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); + Writeln( 'CountMidTime : ' + inttostr(trunc(TimeMid)) ); + {$ENDIF} end; + function TTime.GetTime: real; var TimeTemp: int64; begin - {$IFDEF win32} - QueryPerformanceCounter(TimeTemp); - Result := TimeTemp / TimeFreq; + {$IFDEF SDLTimer} + TimeTemp := SDL_GetTicks(); + Result := TimeTemp / cSDLCorrectionRatio; // TODO - JB_Linux will prob need looking at {$ELSE} - TimeTemp := CurrentSec100OfDay(); - Result := TimeTemp; // TODO - JB_Linux will prob need looking at + {$IFDEF win32} + QueryPerformanceCounter(TimeTemp); + Result := TimeTemp / TimeFreq; + {$ELSE} + TimeTemp := CurrentSec100OfDay(); + Result := TimeTemp; // TODO - JB_Linux will prob need looking at + {$ENDIF} + {$ENDIF} + + {$IFDEF DebugDisplay} + Writeln( 'GetTime : ' + inttostr(trunc(Result)) ); {$ENDIF} end; diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index b2ba01dc..d3cd4ac7 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -1,17 +1,21 @@ -{############################################################################ -# FFmpeg support for UltraStar deluxe # -# # -# Created by b1indy # -# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # -#############################################################################} - -//{$define DebugDisplay} // uncomment if u want to see the debug stuff +unit UVideo; +{< ############################################################################# +# 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 # +# # +############################################################################## } + +{$define DebugDisplay} // uncomment if u want to see the debug stuff //{$define DebugFrames} //{$define Info} +{} -unit UVideo; - interface {$IFDEF FPC} @@ -43,10 +47,26 @@ procedure FFmpegDrawGL(Screen: integer); procedure FFmpegTogglePause; procedure FFmpegSkip(Time: Single); +{ + @author(Jay Binks ) + @created(2007-10-09) + @lastmod(2007-10-09) + + @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) + + translated from "Setting Up the Audio" section at + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + } +function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + var VideoOpened, VideoPaused: Boolean; VideoFormatContext: PAVFormatContext; - VideoStreamIndex: Integer; + VideoStreamIndex , + AudioStreamIndex : Integer; VideoCodecContext: PAVCodecContext; VideoCodec: PAVCodec; AVFrame: PAVFrame; @@ -61,6 +81,11 @@ var VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; VideoSkipTime: Single; + + WantedAudioCodecContext, + AudioCodecContext : PSDL_AudioSpec; + aCodecCtx : PAVCodecContext; + implementation {$ifdef DebugDisplay} @@ -74,13 +99,13 @@ end; {$endif} {$ENDIF} +{ ------------------------------------------------------------------------------ +asdf +------------------------------------------------------------------------------ } procedure Init; begin av_register_all; - {$ifdef DebugDisplay} - showmessage( 'AV_Register_ALL' ); - {$endif} - + VideoOpened:=False; VideoPaused:=False; @@ -88,9 +113,61 @@ begin SetLength(TexData,0); end; +{ + @author(Jay Binks ) + @created(2007-10-09) + @lastmod(2007-10-09) + + @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) + + translated from "Setting Up the Audio" section at + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html +} +function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; +var + i : integer; + st : pAVStream; +begin + // Find the first video stream + aFirstAudioStream := -1; + aFirstVideoStream := -1; + + writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) ); + writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) ); + + i := 0; + while ( i < aFormatCtx.nb_streams ) do +// while ( i < length(aFormatCtx.streams)-1 ) do + begin + writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); + 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; + + inc( i ); + end; // while + + result := (aFirstAudioStream > -1) OR + (aFirstVideoStream > -1) ; // Didn't find a video stream +end; + procedure FFmpegOpenFile(FileName: pAnsiChar); var errnum, i, x,y: Integer; lStreamsCount : Integer; + begin VideoOpened := False; VideoPaused := False; @@ -98,9 +175,12 @@ begin VideoTime := 0; LastFrameTime := 0; TimeDifference := 0; + VideoFormatContext := 0; + + writeln( Filename ); errnum := av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); - + writeln( 'Errnum : ' +inttostr( errnum )); if(errnum <> 0) then begin {$ifdef DebugDisplay} @@ -119,46 +199,36 @@ begin end else begin - VideoStreamIndex:=-1; + VideoStreamIndex := -1; + AudioStreamIndex := -1; // Find which stream contains the video - if(av_find_stream_info(VideoFormatContext) >= 0) then + if( av_find_stream_info(VideoFormatContext) >= 0 ) then begin - {$ifdef DebugDisplay} - writeln( 'FFMPEG debug... VideoFormatContext^.nb_streams : '+ inttostr( VideoFormatContext^.nb_streams ) ); - {$endif} - for i:= 0 to MAX_STREAMS-1 do - begin - {$ifdef DebugDisplay} - writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' stream val ' + inttostr( integer(VideoFormatContext^.streams[i] ) ) ); - {$endif} - try - if assigned( VideoFormatContext ) AND - assigned( VideoFormatContext^.streams[i] ) AND - assigned( VideoFormatContext^.streams[i]^.codec ) THEN - begin - {$ifdef DebugDisplay} - writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' code val ' + inttostr( integer(VideoFormatContext^.streams[i].codec ) ) ); - writeln( 'FFMPEG debug... found stream '+ inttostr(i) + ' code Type ' + inttostr( integer(VideoFormatContext^.streams[i].codec^.codec_type ) ) ); - {$endif} - if(VideoFormatContext^.streams[i]^.codec^.codec_type=CODEC_TYPE_VIDEO) then - begin - {$ifdef DebugDisplay} - writeln( 'FFMPEG debug, found CODEC_TYPE_VIDEO stream' ); - {$endif} - VideoStreamIndex:=i; - end - else - end; - except - // TODO : JB_Linux ... this is excepting at line 108... ( Was 111 previously.. so its prob todo with streams[i]^.codec .. - {$ifdef DebugDisplay} - writeln( 'FFMPEG error, finding video stream' ); - {$endif} - end; + find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); + + writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); + writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); + end; +(* + aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; - end; + WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; + WantedAudioCodecContext.format := AUDIO_S16SYS; + WantedAudioCodecContext.channels := aCodecCtx^.channels; + WantedAudioCodecContext.silence := 0; + WantedAudioCodecContext.samples := 1024;//SDL_AUDIO_BUFFER_SIZE; +// WantedAudioCodecContext.callback := audio_callback; + WantedAudioCodecContext.userdata := aCodecCtx; + + + + if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then + begin + writeln( 'Could not do SDL_OpenAudio' ); + exit; end; +*) if(VideoStreamIndex >= 0) then begin @@ -173,6 +243,7 @@ begin av_close_input_file(VideoFormatContext); Exit; end; + if(VideoCodec<>Nil) then begin @@ -188,11 +259,10 @@ begin if(errnum >=0) then begin {$ifdef DebugDisplay} - showmessage('Found a matching Codec:'+#13#10#13#10+ - 'Width='+inttostr(VideoCodecContext^.width)+ - ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ - 'Aspect: '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ - 'Framerate: '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den)); + showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ + ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den)); {$endif} // allocate space for decoded frame and rgb frame AVFrame:=avcodec_alloc_frame; @@ -253,6 +323,7 @@ begin end; {$ifdef DebugDisplay} showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); + if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then showmessage('you are trying to play a rather large video'+#13#10+ 'be prepared to experience some timing problems'); @@ -303,39 +374,53 @@ const FRAMEDROPCOUNT=3; begin if not VideoOpened then Exit; + if VideoPaused then Exit; + myTime:=Time+VideoSkipTime; TimeDifference:=myTime-VideoTime; DropFrame:=False; -{ showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ + +{$IFDEF DebugDisplay} + showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); -} - if (VideoTime <> 0) and (TimeDifference <= VideoTimeBase) then begin +{$endif} + + 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} -{ showmessage('not getting new frame'+#13#10+ + +{$IFDEF DebugDisplay} + showmessage('not getting new frame'+#13#10+ 'Time: '+inttostr(floor(Time*1000))+#13#10+ 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); -} +{$endif} + Exit;// we don't need a new frame now end; + VideoTime:=VideoTime+VideoTimeBase; TimeDifference:=myTime-VideoTime; - if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then begin // skip frames + if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames + begin {$ifdef DebugFrames} //frame drop debug display GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); {$endif} -// showmessage('skipping frames'+#13#10+ -// 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ -// 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ -// 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); + +{$IFDEF DebugDisplay} + showmessage('skipping frames'+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ + 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); +{$endif} // av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time*VideoTimeBase),0); { av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} @@ -343,30 +428,41 @@ begin DropFrame:=True; end; - av_init_packet(@AVPacket); +// av_init_packet(@AVPacket); + av_init_packet( AVPacket ); // JB-ffmpeg + FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do +// while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, AVPacket)>=0) do // JB-ffmpeg begin // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then - errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, - AVPacket.data, AVPacket.size); +// errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished , AVPacket.data, AVPacket.size); + errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + + // release internal packet structure created by av_read_frame - av_free_packet(PAVPacket(@AVPacket)); +// av_free_packet(PAVPacket(@AVPacket)); + av_free_packet( AVPacket ); // JB-ffmpeg end; + if DropFrame then for droppedFrames:=1 to FRAMEDROPCOUNT do begin FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do +// while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do + while (FrameFinished=0) and (av_read_frame(VideoFormatContext, AVPacket)>=0) do // JB-ffmpeg begin // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then - errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, - AVPacket.data, AVPacket.size); +// errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, AVPacket.data, AVPacket.size); + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + + // release internal packet structure created by av_read_frame - av_free_packet(PAVPacket(@AVPacket)); +// av_free_packet(PAVPacket(@AVPacket)); // JB-ffmpeg + av_free_packet( AVPacket ); end; end; @@ -380,12 +476,16 @@ begin PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, VideoCodecContext^.width, VideoCodecContext^.height); //errnum:=1; - if errnum >=0 then begin + + if errnum >=0 then + begin // copy RGB pixeldata to our TextureBuffer // (line by line) - FrameDataPtr:=AVFrameRGB^.data[0]; - linesize:=AVFrameRGB^.linesize[0]; - for y:=0 to TexY-1 do begin + + FrameDataPtr := pointer( AVFrameRGB^.data[0] ); + linesize := AVFrameRGB^.linesize[0]; + for y:=0 to TexY-1 do + begin System.Move(FrameDataPtr[y*linesize],TexData[3*y*dataX],linesize); end; -- cgit v1.2.3 From 0d997f8433e982584a0ab67a6d630d12f4314759 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 11 Oct 2007 10:50:01 +0000 Subject: fixes so codebase builds in delphi now, after major FFMpeg changse for linux. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@503 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULCD.pas | 16 ++++++++++------ Game/Code/Classes/UVideo.pas | 4 ++-- 2 files changed, 12 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas index 52b0f96a..50214ad0 100644 --- a/Game/Code/Classes/ULCD.pas +++ b/Game/Code/Classes/ULCD.pas @@ -46,6 +46,7 @@ uses {$IFDEF UseSerialPort} zlportio, {$ENDIF} + SDL, UTime; procedure TLCD.WriteCommand(B: Byte); @@ -64,7 +65,7 @@ begin zlioportwrite(Data, 0, B and $F0); zlioportwrite(Control, 0, $03); - TimeSleep(0.1); + SDL_Delay( 100 ); zlioportwrite(Control, 0, $02); zlioportwrite(Data, 0, (B * 16) and $F0); @@ -74,7 +75,7 @@ begin if (B=1) or (B=2) then Sleep(2) else - TimeSleep(0.1); + SDL_Delay( 100 ); {$ENDIF} end; @@ -82,23 +83,26 @@ procedure TLCD.WriteData(B: Byte); // Wysylanie danych begin {$IFDEF UseSerialPort} - if not HalfInterface then begin + if not HalfInterface then + begin zlioportwrite(Control, 0, $06); zlioportwrite(Data, 0, B); zlioportwrite(Control, 0, $07); - end else begin + end + else + begin zlioportwrite(Control, 0, $06); zlioportwrite(Data, 0, B and $F0); zlioportwrite(Control, 0, $07); - TimeSleep(0.1); + SDL_Delay( 100 ); zlioportwrite(Control, 0, $06); zlioportwrite(Data, 0, (B * 16) and $F0); zlioportwrite(Control, 0, $07); end; - TimeSleep(0.1); + SDL_Delay( 100 ); Inc(Position); {$ENDIF} end; diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index d3cd4ac7..2dd745fd 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -89,14 +89,14 @@ var implementation {$ifdef DebugDisplay} -{$ifNdef win32} +//{$ifNdef win32} procedure showmessage( aMessage : String ); begin writeln( aMessage ); end; -{$endif} +//{$endif} {$ENDIF} { ------------------------------------------------------------------------------ -- cgit v1.2.3 From 44554c7908f7e2405a249331f00a35703f5939c2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 11 Oct 2007 12:02:20 +0000 Subject: Added IAudioPlayback Interface and implementation for BASS. Created "AudioPlayback" Global Singleton, which removed the need for the "Music" Global variable. This was done because global singleton objects are a recognized better "design pattern" achieving the same thing as global variables, but in a nicer way. I will be working to a) separate IAudioPlayback in to separate "Playback" and "Input" Interfaces b) build a FFMpeg class that implements IAudioPlayback git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@504 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2 +- Game/Code/Classes/ULyrics.pas | 5 +- Game/Code/Classes/UMain.pas | 4 +- Game/Code/Classes/UMusic.pas | 802 ++++---------------------------------- Game/Code/Classes/UMusic_BASS.pas | 703 +++++++++++++++++++++++++++++++++ Game/Code/Classes/UTime.pas | 81 +--- Game/Code/Classes/UVideo.pas | 3 +- 7 files changed, 795 insertions(+), 805 deletions(-) create mode 100644 Game/Code/Classes/UMusic_BASS.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index a8404355..473e9017 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -470,7 +470,7 @@ var lTmpB : real; begin if (Player[NrGracza].ScoreTotalI >= 0) then begin - glColor4f(1, 1, 1, sqrt((1+sin(Music.Position * 3))/4)/ 2 + 0.5 ); + 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); diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 4fd360b7..e4ac2024 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -8,7 +8,10 @@ interface {$I switches.inc} -uses OpenGL12, UTexture, UThemes, UMusic; +uses OpenGL12, + UTexture, + UThemes, + UMusic; type TLyricWord = record diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 41676bf3..40b91be7 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -520,7 +520,7 @@ begin // beat click if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - Music.PlayClick; + AudioPlayback.PlayClick; // debug system on LPT if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin @@ -542,7 +542,7 @@ begin if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin // click assist if Ini.ClickAssist = 1 then - Music.PlayClick; + AudioPlayback.PlayClick; //LPT_2 := 0; if ParamStr(1) <> '-doublelights' then diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 3c43615b..934e14e3 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -8,145 +8,8 @@ interface {$MODE Delphi} {$ENDIF} - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - UCommon, - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - {$IFDEF useBASS} - bass, - {$ENDIF} - ULog, - USongs; - - -procedure InitializeSound; - -type - TSoundCard = record - Name: string; - Source: array of string; - end; - - TFFTData = array [0..256] of Single; - - TCustomSoundEntry = record - Filename : String; - Handle : hStream; - end; - - IAudioPlayback = Interface - procedure InitializePlayback; - - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - - function Open(Name: string): boolean; // true if succeed - - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - - procedure Rewind; - procedure MoveTo(Time: real); - procedure Close; - - function Finished: boolean; - function Length: real; - function Position: real; - - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal); - end; - - - TMusic = class( TInterfacedObject, IAudioPlayback ) - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - - function FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; - - public - Bass: hStream; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function Position: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal); -end; - -const - RecordSystem = 1; +uses Classes // UCommon + ; type TMuzyka = record @@ -216,621 +79,104 @@ type Razem: real; // caly czas utworu end; -var - Music: TMusic; - - // muzyka - Muzyka: TMuzyka; - - // czesci z nutami; - Czesci: array of TCzesci; - - // czas - Czas: TCzas; - - fHWND: Thandle; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -implementation - -uses - {$IFDEF FPC} - lclintf, - {$ENDIF} - - avcodec, - avformat, - avutil, - - UGraphic, - URecord, - UFiles, - UIni, - UMain, - UThemes; - -procedure InitializeSound; -begin - Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback; - Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord; -end; - -procedure TMusic.InitializePlayback; -var - Pet: integer; - S: integer; -begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - {$ifdef win32} - // TODO : JB_Linux ... is this needed ? :) - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - {$ENDIF} - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB_linux find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - {$ENDIF} - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - Log.LogStatus('Loading Sounds', 'Music Initialize'); - - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - - Log.BenchmarkEnd(4); - Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TMusic.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TMusic.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); - {$ENDIF} -end; - -procedure TMusic.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - //Set Volume - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); - {$ENDIF} -end; - -procedure TMusic.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TMusic.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - {$ENDIF} - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TMusic.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TMusic.MoveTo(Time: real); -var - bytes: integer; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); - {$ENDIF} -end; - -procedure TMusic.Play; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing + TSoundCard = record + Name: string; + Source: array of string; end; - {$ENDIF} -end; -procedure TMusic.Pause; //Pause Mod -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; - {$ENDIF} -end; - -procedure TMusic.Stop; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); - {$ENDIF} -end; - -procedure TMusic.Close; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); - {$ENDIF} -end; - -function TMusic.Length: real; -var - bytes: integer; -begin - Result := 60; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); - {$ENDIF} -end; - -function TMusic.Position: real; -var - bytes: integer; -begin - Result := 0; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); - {$ENDIF} -end; + TFFTData = array [0..256] of Single; -function TMusic.Finished: boolean; -begin - Result := false; + hStream = Cardinal; - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; + TCustomSoundEntry = record + Filename : String; + Handle : hStream; end; - {$ENDIF} -end; - -procedure TMusic.PlayStart; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); - {$ENDIF} -end; - -procedure TMusic.PlayBack; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then - {$ENDIF} -end; - -procedure TMusic.PlaySwoosh; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); - {$ENDIF} -end; - -procedure TMusic.PlayChange; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); - {$ENDIF} -end; - -procedure TMusic.PlayOption; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); - {$ENDIF} -end; - -procedure TMusic.PlayClick; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); - {$ENDIF} -end; -procedure TMusic.PlayDrum; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); - {$ENDIF} -end; - -procedure TMusic.PlayHihat; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); - {$ENDIF} -end; - -procedure TMusic.PlayClap; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); - {$ENDIF} -end; - -procedure TMusic.PlayShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); - {$ENDIF} -end; +type + IAudioPlayback = Interface + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -procedure TMusic.StopShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); - {$ENDIF} -end; + //Equalizer + function GetFFTData: TFFTData; -procedure TMusic.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); end; -end; -procedure TMusic.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; +var // TODO : JB --- THESE SHOULD NOT BE GLOBAL + // muzyka + Muzyka: TMuzyka; -end; + // czesci z nutami; + Czesci: array of TCzesci; -//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if not BASS_RecordInit(RecordI) then - begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; + // czas + Czas: TCzas; - {$ENDIF} -end; - -procedure TMusic.StopCard(Card: byte); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; - {$ENDIF} -end; -function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - {$ELSE} - hStream := FFMPeg_StreamCreateFile(False, pchar(Name) ); - {$ENDIF} - - - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end - else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; +procedure InitializeSound; +function AudioPlayback(): IAudioPlayback; -//Equalizer -function TMusic.GetFFTData: TFFTData; -var -Data: TFFTData; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass +implementation - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - //Result := Data; - - {$ENDIF} -end; +uses + uLog, + UMusic_BASS; -function TMusic.LoadCustomSound(const Filename: String): Cardinal; var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; + singleton_AudioPlayback : IAudioPlayback; -procedure TMusic.PlayCustomSound(const Index: Cardinal); +function AudioPlayback(): IAudioPlayback; begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass + if singleton_AudioPlayback = nil then + begin + writeln( 'Created AudioPlayback' ); + singleton_AudioPlayback := TMusic_bass.create(); + end; - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); - - {$ENDIF} + result := singleton_AudioPlayback; end; - -{* - -Sorry guys... this is my mess :( -Im going to try and get ffmpeg to handle audio playback ( at least for linux ) -and Im going to implement it nicly along side BASS, in TMusic ( where I can ) - -http://www.dranger.com/ffmpeg/ffmpeg.html -http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - -http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*} -function TMusic.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; -var - lFormatCtx : PAVFormatContext; +procedure InitializeSound; begin + Log.LogStatus('Initializing Playback', 'InitializeSound'); + AudioPlayback.InitializePlayback; -(* - if(SDL_OpenAudio(&wanted_spec, &spec) < 0) - begin - fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); - writeln( 'SDL_OpenAudio' ); - exit; - end; -*) - -(* - if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) - begin - writeln( 'Unable to open file '+ aFileName ); - exit; - end; - - // Retrieve stream information - if ( av_find_stream_info(pFormatCtx) < 0 ) - begin - writeln( 'Unable to Retrieve stream information' ); - exit; - end; -*) - + Log.LogStatus('Initializing Record', 'InitializeSound'); + AudioPlayback.InitializeRecord; end; end. diff --git a/Game/Code/Classes/UMusic_BASS.pas b/Game/Code/Classes/UMusic_BASS.pas new file mode 100644 index 00000000..dfb6f79c --- /dev/null +++ b/Game/Code/Classes/UMusic_BASS.pas @@ -0,0 +1,703 @@ +unit UMusic_BASS; + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + + {$IFDEF win32} + windows, + {$ENDIF} + +// UCommon, + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + + bass, + ULog, + UMusic; +// USongs; +// Classes; + + + +type + + TMusic_bass = class( TInterfacedObject, IAudioPlayback ) + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + fHWND: THandle; + + public + Bass: hStream; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); +end; + +const + RecordSystem = 1; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + +// avcodec, +// avformat, +// avutil, + +// UGraphic, + URecord, +// UFiles, + UIni, + UMain, + UThemes; + + + +procedure TMusic_bass.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + {$ifdef win32} + // TODO : JB_Linux ... is this needed ? :) + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + {$ENDIF} + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_linux find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + {$ENDIF} + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); + Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TMusic_bass.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TMusic_bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); + {$ENDIF} +end; + +procedure TMusic_bass.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + {$ENDIF} +end; + +procedure TMusic_bass.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TMusic_bass.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + {$ENDIF} + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TMusic_bass.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TMusic_bass.MoveTo(Time: real); +var + bytes: integer; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); + {$ENDIF} +end; + +procedure TMusic_bass.Play; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic_bass Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; + {$ENDIF} +end; + +procedure TMusic_bass.Pause; //Pause Mod +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; + {$ENDIF} +end; + +procedure TMusic_bass.Stop; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); + {$ENDIF} +end; + +procedure TMusic_bass.Close; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); + {$ENDIF} +end; + +function TMusic_bass.Length: real; +var + bytes: integer; +begin + Result := 60; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); + {$ENDIF} +end; + +function TMusic_bass.Position: real; +var + bytes: integer; +begin + Result := 0; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); + {$ENDIF} +end; + +function TMusic_bass.Finished: boolean; +begin + Result := false; + + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; + {$ENDIF} +end; + +procedure TMusic_bass.PlayStart; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayBack; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then + {$ENDIF} +end; + +procedure TMusic_bass.PlaySwoosh; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayChange; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayOption; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayClick; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayDrum; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayHihat; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayClap; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); + {$ENDIF} +end; + +procedure TMusic_bass.PlayShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); + {$ENDIF} +end; + +procedure TMusic_bass.StopShuffle; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); + {$ENDIF} +end; + +procedure TMusic_bass.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TMusic_bass.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TMusic_bass.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TMusic_bass.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if not BASS_RecordInit(RecordI) then + begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; + + {$ENDIF} +end; + +procedure TMusic_bass.StopCard(Card: byte); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; + {$ENDIF} +end; + +function TMusic_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + {$ELSE} + hStream := FFMPeg_StreamCreateFile(False, pchar(Name) ); + {$ENDIF} + + + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TMusic_bass.GetFFTData: TFFTData; +var +Data: TFFTData; +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + //Result := Data; + + {$ENDIF} +end; + +function TMusic_bass.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TMusic_bass.PlayCustomSound(const Index: Cardinal ); +begin + {$IFDEF useBASS} + // TODO : jb_linux replace with something other than bass + + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); + + {$ENDIF} +end; + + +{* + +Sorry guys... this is my mess :( +Im going to try and get ffmpeg to handle audio playback ( at least for linux ) +and Im going to implement it nicly along side BASS, in TMusic_bass ( where I can ) + +http://www.dranger.com/ffmpeg/ffmpeg.html +http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + +http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*} +{* +function TMusic_bass.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; +var + lFormatCtx : PAVFormatContext; +begin + +(* + if(SDL_OpenAudio(&wanted_spec, &spec) < 0) + begin + fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); + writeln( 'SDL_OpenAudio' ); + exit; + end; +*) + +(* + if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) + begin + writeln( 'Unable to open file '+ aFileName ); + exit; + end; + + // Retrieve stream information + if ( av_find_stream_info(pFormatCtx) < 0 ) + begin + writeln( 'Unable to Retrieve stream information' ); + exit; + end; +*) + +end; *} + +end. diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index edd65b7e..87d17ee5 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -6,7 +6,6 @@ interface {$MODE Delphi} {$ENDIF} -{$DEFINE SDLTimer} {$UNDEF DebugDisplay} type @@ -22,7 +21,6 @@ procedure CountMidTime; var USTime: TTime; - TimeFreq: int64; TimeNew: int64; TimeOld: int64; TimeSkip: real; @@ -32,16 +30,8 @@ var implementation uses - {$IFDEF win32} - windows, - {$ELSE} - libc, - time, - {$ENDIF} - sysutils, - {$IFDEF SDLTimer} +// sysutils, sdl, - {$ENDIF} ucommon; const @@ -65,18 +55,7 @@ end; procedure CountSkipTimeSet; begin - {$IFDEF SDLTimer} - TimeNew := SDL_GetTicks(); // / cSDLCorrectionRatio - TimeFreq := 0; - {$ELSE} - {$IFDEF win32} - QueryPerformanceFrequency(TimeFreq); - QueryPerformanceCounter(TimeNew); - {$ELSE} - TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at - TimeFreq := 0; - {$ENDIF} - {$ENDIF} + TimeNew := SDL_GetTicks(); {$IFDEF DebugDisplay} Writeln( 'CountSkipTimeSet : ' + inttostr(trunc(TimeNew)) ); @@ -86,26 +65,9 @@ end; procedure CountSkipTime; begin - TimeOld := TimeNew; - - {$IFDEF SDLTimer} - TimeNew := SDL_GetTicks(); - TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; - {$ELSE} - {$IFDEF win32} - QueryPerformanceCounter(TimeNew); - - if ( TimeNew-TimeOld > 0 ) AND - ( TimeFreq > 0 ) THEN - begin - TimeSkip := (TimeNew-TimeOld)/TimeFreq; - end; - - {$ELSE} - TimeNew := CurrentSec100OfDay(); // TODO - JB_Linux will prob need looking at - TimeSkip := (TimeNew-TimeOld); - {$ENDIF} - {$ENDIF} + TimeOld := TimeNew; + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; {$IFDEF DebugDisplay} Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); @@ -116,43 +78,20 @@ end; procedure CountMidTime; begin - {$IFDEF SDLTimer} - TimeMidTemp := SDL_GetTicks(); - TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; - {$ELSE} - {$IFDEF win32} - QueryPerformanceCounter(TimeMidTemp); - TimeMid := (TimeMidTemp-TimeNew)/TimeFreq; - {$ELSE} - TimeMidTemp := CurrentSec100OfDay(); - TimeMid := (TimeMidTemp-TimeNew); // TODO - JB_Linux will prob need looking at - {$ENDIF} - {$ENDIF} + TimeMidTemp := SDL_GetTicks(); + TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; {$IFDEF DebugDisplay} - Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); + Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); Writeln( 'CountMidTime : ' + inttostr(trunc(TimeMid)) ); {$ENDIF} end; function TTime.GetTime: real; -var - TimeTemp: int64; begin - {$IFDEF SDLTimer} - TimeTemp := SDL_GetTicks(); - Result := TimeTemp / cSDLCorrectionRatio; // TODO - JB_Linux will prob need looking at - {$ELSE} - {$IFDEF win32} - QueryPerformanceCounter(TimeTemp); - Result := TimeTemp / TimeFreq; - {$ELSE} - TimeTemp := CurrentSec100OfDay(); - Result := TimeTemp; // TODO - JB_Linux will prob need looking at - {$ENDIF} - {$ENDIF} - + Result := SDL_GetTicks() / cSDLCorrectionRatio; + {$IFDEF DebugDisplay} Writeln( 'GetTime : ' + inttostr(trunc(Result)) ); {$ENDIF} diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 2dd745fd..ed1e5fe3 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -210,7 +210,6 @@ begin writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); end; -(* aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; @@ -222,7 +221,7 @@ begin WantedAudioCodecContext.userdata := aCodecCtx; - +(* if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then begin writeln( 'Could not do SDL_OpenAudio' ); -- cgit v1.2.3 From 6292440f6da3c11e85bb9fc3a741a26540e429be Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 11 Oct 2007 12:12:37 +0000 Subject: separated IAudioPlayback in to separate "Playback" and "Input" Interfaces ( both interfaces provided by same TMusic_Bass class... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@505 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 39 ++++++++++++++++++++++++++++++--------- Game/Code/Classes/UMusic_BASS.pas | 2 +- 2 files changed, 31 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 934e14e3..a2620607 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -96,7 +96,6 @@ type type IAudioPlayback = Interface procedure InitializePlayback; - procedure InitializeRecord; procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); @@ -121,18 +120,25 @@ type procedure PlayClap; procedure PlayShuffle; procedure StopShuffle; + + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + end; + + IAudioInput = Interface + procedure InitializeRecord; + procedure CaptureStart; procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; //Equalizer function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); end; @@ -147,8 +153,11 @@ var // TODO : JB --- THESE SHOULD NOT BE GLOBAL Czas: TCzas; -procedure InitializeSound; +procedure InitializeSound; + function AudioPlayback(): IAudioPlayback; +function AudioInput(): IAudioInput; + implementation @@ -158,25 +167,37 @@ uses var singleton_AudioPlayback : IAudioPlayback; + singleton_AudioInput : IAudioInput; function AudioPlayback(): IAudioPlayback; begin if singleton_AudioPlayback = nil then begin writeln( 'Created AudioPlayback' ); - singleton_AudioPlayback := TMusic_bass.create(); + singleton_AudioPlayback := TMusic_bass.create(); // Yes we could do this with one instance of TMusic_Bass... but I cant be bothered at this point:P end; result := singleton_AudioPlayback; end; +function AudioInput(): IAudioInput; +begin + if singleton_AudioInput = nil then + begin + writeln( 'Created AudioInput' ); + singleton_AudioInput := TMusic_bass.create(); // Yes we could do this with one instance of TMusic_Bass... but I cant be bothered at this point:P + end; + + result := singleton_AudioInput; +end; + procedure InitializeSound; begin Log.LogStatus('Initializing Playback', 'InitializeSound'); AudioPlayback.InitializePlayback; Log.LogStatus('Initializing Record', 'InitializeSound'); - AudioPlayback.InitializeRecord; + AudioInput.InitializeRecord; end; end. diff --git a/Game/Code/Classes/UMusic_BASS.pas b/Game/Code/Classes/UMusic_BASS.pas index dfb6f79c..7de2d781 100644 --- a/Game/Code/Classes/UMusic_BASS.pas +++ b/Game/Code/Classes/UMusic_BASS.pas @@ -32,7 +32,7 @@ uses Classes, type - TMusic_bass = class( TInterfacedObject, IAudioPlayback ) + TMusic_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput ) private BassStart: hStream; // Wait, I've replaced this with BASS BassBack: hStream; // It has almost all features we need -- cgit v1.2.3 From df37a6a52ea5b1856e9e0e4d924a859f3fa472e1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 11 Oct 2007 13:32:43 +0000 Subject: added UAudio_FFMpeg.pas as placeholder... ( Still has bass code in it.. needs to be replaced with ffmpeg code ) UMusic ( And UAudio* ) files, now have proper IAudioPlayback and IAudioInput Interface enumeration. simply having the unit in the uses clause will make it available. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@506 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 634 ++++++++++++++++++++++++++++++++ Game/Code/Classes/UAudio_bass.pas | 637 ++++++++++++++++++++++++++++++++ Game/Code/Classes/UMusic.pas | 87 ++++- Game/Code/Classes/UMusic_BASS.pas | 703 ------------------------------------ 4 files changed, 1338 insertions(+), 723 deletions(-) create mode 100644 Game/Code/Classes/UAudio_FFMpeg.pas create mode 100644 Game/Code/Classes/UAudio_bass.pas delete mode 100644 Game/Code/Classes/UMusic_BASS.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas new file mode 100644 index 00000000..2a3c5cb5 --- /dev/null +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -0,0 +1,634 @@ +unit UAudio_FFMpeg; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UThemes; + +const + RecordSystem = 1; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +type + TAudio_ffMpeg = class( TInterfacedObject, IAudioPlayback ) + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + fHWND: THandle; + + public + Bass: hStream; + function GetName: String; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); +end; + +var + singleton_MusicFFMpeg : IAudioPlayback; + +function TAudio_ffMpeg.GetName: String; +begin + result := 'FFMpeg'; +end; + +procedure TAudio_ffMpeg.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + {$ifdef win32} + // TODO : JB_Linux ... is this needed ? :) + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + {$ENDIF} + + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_linux find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); + Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TAudio_ffMpeg.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TAudio_ffMpeg.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudio_ffMpeg.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_ffMpeg.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_ffMpeg.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_ffMpeg.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TAudio_ffMpeg.MoveTo(Time: real); +var + bytes: integer; +begin + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_ffMpeg.Play; +begin + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_ffMpeg Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; +end; + +procedure TAudio_ffMpeg.Pause; //Pause Mod +begin + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; +end; + +procedure TAudio_ffMpeg.Stop; +begin + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); +end; + +procedure TAudio_ffMpeg.Close; +begin + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); +end; + +function TAudio_ffMpeg.Length: real; +var + bytes: integer; +begin + Result := 60; + + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); +end; + +function TAudio_ffMpeg.Position: real; +var + bytes: integer; +begin + Result := 0; + + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +end; + +function TAudio_ffMpeg.Finished: boolean; +begin + Result := false; + + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +end; + +procedure TAudio_ffMpeg.PlayStart; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); +end; + +procedure TAudio_ffMpeg.PlayBack; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then +end; + +procedure TAudio_ffMpeg.PlaySwoosh; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); +end; + +procedure TAudio_ffMpeg.PlayChange; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); +end; + +procedure TAudio_ffMpeg.PlayOption; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); +end; + +procedure TAudio_ffMpeg.PlayClick; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); +end; + +procedure TAudio_ffMpeg.PlayDrum; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); +end; + +procedure TAudio_ffMpeg.PlayHihat; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); +end; + +procedure TAudio_ffMpeg.PlayClap; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); +end; + +procedure TAudio_ffMpeg.PlayShuffle; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); +end; + +procedure TAudio_ffMpeg.StopShuffle; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); +end; + +procedure TAudio_ffMpeg.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TAudio_ffMpeg.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TAudio_ffMpeg.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TAudio_ffMpeg.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + if not BASS_RecordInit(RecordI) then + begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; +end; + +procedure TAudio_ffMpeg.StopCard(Card: byte); +begin + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + +function TAudio_ffMpeg.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TAudio_ffMpeg.GetFFTData: TFFTData; +var + Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +end; + +function TAudio_ffMpeg.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_ffMpeg.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); +end; + + +{* + +Sorry guys... this is my mess :( +Im going to try and get ffmpeg to handle audio playback ( at least for linux ) +and Im going to implement it nicly along side BASS, in TAudio_ffMpeg ( where I can ) + +http://www.dranger.com/ffmpeg/ffmpeg.html +http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + +http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*} +{* +function TAudio_ffMpeg.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; +var + lFormatCtx : PAVFormatContext; +begin + +(* + if(SDL_OpenAudio(&wanted_spec, &spec) < 0) + begin + fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); + writeln( 'SDL_OpenAudio' ); + exit; + end; +*) + +(* + if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) + begin + writeln( 'Unable to open file '+ aFileName ); + exit; + end; + + // Retrieve stream information + if ( av_find_stream_info(pFormatCtx) < 0 ) + begin + writeln( 'Unable to Retrieve stream information' ); + exit; + end; +*) + +end; *} + +initialization + singleton_MusicFFMpeg := TAudio_ffMpeg.create(); + + writeln( 'UAudio_Bass - Register Playback' ); + AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); + +finalization + AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); + + +end. diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas new file mode 100644 index 00000000..cbeadc47 --- /dev/null +++ b/Game/Code/Classes/UAudio_bass.pas @@ -0,0 +1,637 @@ +unit UAudio_bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF FPC} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UThemes; + +const + RecordSystem = 1; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +type + TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput ) + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + fHWND: THandle; + + public + Bass: hStream; + function GetName: String; + procedure InitializePlayback; + procedure InitializeRecord; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function Position: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); +end; + +var + singleton_MusicBass : IAudioPlayback; + +function TAudio_bass.GetName: String; +begin + result := 'BASS'; +end; + +procedure TAudio_bass.InitializePlayback; +var + Pet: integer; + S: integer; +begin + Log.BenchmarkStart(4); + Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + {$ifdef win32} + // TODO : JB_Linux ... is this needed ? :) + fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function + {$ENDIF} + + // TODO : jb_linux replace with something other than bass + if not BASS_Init(1, 44100, 0, fHWND, nil) then + begin + {$IFNDEF FPC} + // TODO : JB_linux find a way to do this nice.. + Application.MessageBox ('Could not initialize BASS', 'Error'); + {$ENDIF} + Exit; + end; + + Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + Log.LogStatus('Loading Sounds', 'Music Initialize'); + + Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + + Log.BenchmarkEnd(4); + Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TAudio_bass.InitializeRecord; +var + S: integer; + device: integer; + descr: string; + input: integer; + input2: integer; + flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input +begin + if RecordSystem = 1 then begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; + + + // check for recording devices; + {device := 0; + descr := BASS_RecordGetDeviceDescription(device); + + SetLength(SoundCard, 0); + while (descr <> '') do begin + SC := High(SoundCard) + 1; + SetLength(SoundCard, SC+1); + + Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); + SoundCard[SC].Description := Descr; + + // check for recording inputs + mic[device] := -1; // default to no change + input := 0; + BASS_RecordInit(device); + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + flags := BASS_RecordGetInput(input); + + SetLength(SoundCard[SC].Input, 0); + while (flags <> -1) do begin + SCI := High(SoundCard[SC].Input) + 1; + SetLength(SoundCard[SC].Input, SCI+1); + + Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); + SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + + if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin + mic[device] := input; // auto set microphone + end; + Inc(Input); + flags := BASS_RecordGetInput(input); + end; + + if mic[device] <> -1 then begin + Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) + end else begin + Log.LogAnalyze('Mic not found'); + mic[device] := 0; // setting to the first one (for kxproject) + end; + SoundCard[SC].InputSeleceted := Mic[Device]; + + + BASS_RecordFree; + + inc(Device); + descr := BASS_RecordGetDeviceDescription(Device); + end; // while} + end; // if +end; + +procedure TAudio_bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + + // TODO : jb_linux replace with something other than bass + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudio_bass.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_bass.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_bass.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + // TODO : jb_linux replace with something other than bass + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_bass.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TAudio_bass.MoveTo(Time: real); +var + bytes: integer; +begin + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_bass.Play; +begin + // TODO : jb_linux replace with something other than bass + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; +end; + +procedure TAudio_bass.Pause; //Pause Mod +begin + // TODO : jb_linux replace with something other than bass + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; +end; + +procedure TAudio_bass.Stop; +begin + // TODO : jb_linux replace with something other than bass + Bass_ChannelStop(Bass); +end; + +procedure TAudio_bass.Close; +begin + // TODO : jb_linux replace with something other than bass + Bass_StreamFree(Bass); +end; + +function TAudio_bass.Length: real; +var + bytes: integer; +begin + Result := 60; + + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); +end; + +function TAudio_bass.Position: real; +var + bytes: integer; +begin + Result := 0; + + // TODO : jb_linux replace with something other than bass + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +end; + +function TAudio_bass.Finished: boolean; +begin + Result := false; + + // TODO : jb_linux replace with something other than bass + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +end; + +procedure TAudio_bass.PlayStart; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassStart, True); +end; + +procedure TAudio_bass.PlayBack; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassBack, True);// then +end; + +procedure TAudio_bass.PlaySwoosh; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassSwoosh, True); +end; + +procedure TAudio_bass.PlayChange; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassChange, True); +end; + +procedure TAudio_bass.PlayOption; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassOption, True); +end; + +procedure TAudio_bass.PlayClick; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClick, True); +end; + +procedure TAudio_bass.PlayDrum; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassDrum, True); +end; + +procedure TAudio_bass.PlayHihat; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassHihat, True); +end; + +procedure TAudio_bass.PlayClap; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassClap, True); +end; + +procedure TAudio_bass.PlayShuffle; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelPlay(BassShuffle, True); +end; + +procedure TAudio_bass.StopShuffle; +begin + // TODO : jb_linux replace with something other than bass + BASS_ChannelStop(BassShuffle); +end; + +procedure TAudio_bass.CaptureStart; +var + S: integer; + SC: integer; + P1: integer; + P2: integer; +begin + for S := 0 to High(Sound) do + Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then + CaptureCard(SC, P1, P2); + end; +end; + +procedure TAudio_bass.CaptureStop; +var + SC: integer; + P1: integer; + P2: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + P1 := Ini.CardList[SC].ChannelL; + P2 := Ini.CardList[SC].ChannelR; + if P1 > PlayersPlay then P1 := 0; + if P2 > PlayersPlay then P2 := 0; + if (P1 > 0) or (P2 > 0) then StopCard(SC); + end; + +end; + +//procedure TAudio_bass.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); +procedure TAudio_bass.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +var + Error: integer; + ErrorMsg: string; +begin + if not BASS_RecordInit(RecordI) then + begin + Error := BASS_ErrorGetCode; + + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + + {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg);} + Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' + + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' + + ErrorMsg); + Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + + + end + else + begin + Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); + end; +end; + +procedure TAudio_bass.StopCard(Card: byte); +begin + // TODO : jb_linux replace with something other than bass + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + +function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + // TODO : jb_linux replace with something other than bass + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TAudio_bass.GetFFTData: TFFTData; +var + Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +end; + +function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); +end; + + +{* + +Sorry guys... this is my mess :( +Im going to try and get ffmpeg to handle audio playback ( at least for linux ) +and Im going to implement it nicly along side BASS, in TAudio_bass ( where I can ) + +http://www.dranger.com/ffmpeg/ffmpeg.html +http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + +http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*} +{* +function TAudio_bass.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; +var + lFormatCtx : PAVFormatContext; +begin + +(* + if(SDL_OpenAudio(&wanted_spec, &spec) < 0) + begin + fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); + writeln( 'SDL_OpenAudio' ); + exit; + end; +*) + +(* + if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) + begin + writeln( 'Unable to open file '+ aFileName ); + exit; + end; + + // Retrieve stream information + if ( av_find_stream_info(pFormatCtx) < 0 ) + begin + writeln( 'Unable to Retrieve stream information' ); + exit; + end; +*) + +end; *} + +initialization + singleton_MusicBass := TAudio_bass.create(); + + writeln( 'UAudio_Bass - Register Playback' ); + AudioManager.add( IAudioPlayback( singleton_MusicBass ) ); + + writeln( 'UAudio_Bass - Register Input' ); + AudioManager.add( IAudioInput( singleton_MusicBass ) ); + +finalization + AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) ); + AudioManager.Remove( IAudioInput( singleton_MusicBass ) ); + +end. diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index a2620607..8aa59d41 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -95,6 +95,8 @@ type type IAudioPlayback = Interface + ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] + function GetName: String; procedure InitializePlayback; procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); @@ -129,6 +131,8 @@ type end; IAudioInput = Interface + ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] + function GetName: String; procedure InitializeRecord; procedure CaptureStart; @@ -158,46 +162,89 @@ procedure InitializeSound; function AudioPlayback(): IAudioPlayback; function AudioInput(): IAudioInput; +function AudioManager: TInterfaceList; + implementation uses - uLog, - UMusic_BASS; + sysutils, + uLog; var singleton_AudioPlayback : IAudioPlayback; singleton_AudioInput : IAudioInput; + singleton_AudioManager : TInterfaceList; + + +function AudioManager: TInterfaceList; +begin + Result := singleton_AudioManager; +end; //CompressionPluginManager + function AudioPlayback(): IAudioPlayback; begin - if singleton_AudioPlayback = nil then - begin - writeln( 'Created AudioPlayback' ); - singleton_AudioPlayback := TMusic_bass.create(); // Yes we could do this with one instance of TMusic_Bass... but I cant be bothered at this point:P - end; - - result := singleton_AudioPlayback; + result := singleton_AudioPlayback; end; function AudioInput(): IAudioInput; begin - if singleton_AudioInput = nil then - begin - writeln( 'Created AudioInput' ); - singleton_AudioInput := TMusic_bass.create(); // Yes we could do this with one instance of TMusic_Bass... but I cant be bothered at this point:P - end; - result := singleton_AudioInput; end; procedure InitializeSound; +var + lTmpPlayBack : IAudioPlayback; + lTmpInput : IAudioInput; + iCount : Integer; begin - Log.LogStatus('Initializing Playback', 'InitializeSound'); - AudioPlayback.InitializePlayback; - - Log.LogStatus('Initializing Record', 'InitializeSound'); - AudioInput.InitializeRecord; + lTmpPlayBack := nil; + lTmpInput := nil; + + writeln( 'InitializeSound , Enumerate Registered Audio Interfaces' ); + for iCount := 0 to singleton_AudioManager.Count - 1 do + begin + if assigned( AudioManager[iCount] ) then + begin + // if this interface is a Playback, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpPlayBack ) = 0 ) AND + ( not assigned( singleton_AudioPlayback ) ) then + begin + singleton_AudioPlayback := lTmpPlayBack; + end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInput ) = 0 ) AND + ( not assigned( singleton_AudioInput ) ) then + begin + singleton_AudioInput := lTmpInput; + end; + end; + end; + + + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + + // Initialize Playback + Log.LogStatus('Initializing Playback ('+AudioPlayback.GetName+')', 'InitializeSound'); + AudioPlayback.InitializePlayback; + + // Initialize Input + Log.LogStatus('Initializing Record ('+AudioPlayback.GetName+')', 'InitializeSound'); + AudioInput.InitializeRecord; end; +initialization +begin + writeln('Init AudioManager'); + singleton_AudioManager := TInterfaceList.Create(); +end; + +finalization + writeln('Finalize AudioManager'); + singleton_AudioManager.clear; + FreeAndNil( singleton_AudioManager ); + end. diff --git a/Game/Code/Classes/UMusic_BASS.pas b/Game/Code/Classes/UMusic_BASS.pas deleted file mode 100644 index 7de2d781..00000000 --- a/Game/Code/Classes/UMusic_BASS.pas +++ /dev/null @@ -1,703 +0,0 @@ -unit UMusic_BASS; - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -uses Classes, - - {$IFDEF win32} - windows, - {$ENDIF} - -// UCommon, - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - - bass, - ULog, - UMusic; -// USongs; -// Classes; - - - -type - - TMusic_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput ) - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - fHWND: THandle; - - public - Bass: hStream; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function Position: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); -end; - -const - RecordSystem = 1; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -implementation - -uses - {$IFDEF FPC} - lclintf, - {$ENDIF} - -// avcodec, -// avformat, -// avutil, - -// UGraphic, - URecord, -// UFiles, - UIni, - UMain, - UThemes; - - - -procedure TMusic_bass.InitializePlayback; -var - Pet: integer; - S: integer; -begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - {$ifdef win32} - // TODO : JB_Linux ... is this needed ? :) - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - {$ENDIF} - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB_linux find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - {$ENDIF} - - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - Log.LogStatus('Loading Sounds', 'Music Initialize'); - - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - - Log.BenchmarkEnd(4); - Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TMusic_bass.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TMusic_bass.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); - {$ENDIF} -end; - -procedure TMusic_bass.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); - {$ENDIF} -end; - -procedure TMusic_bass.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TMusic_bass.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - {$ENDIF} - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TMusic_bass.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TMusic_bass.MoveTo(Time: real); -var - bytes: integer; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); - {$ENDIF} -end; - -procedure TMusic_bass.Play; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic_bass Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; - {$ENDIF} -end; - -procedure TMusic_bass.Pause; //Pause Mod -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; - {$ENDIF} -end; - -procedure TMusic_bass.Stop; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); - {$ENDIF} -end; - -procedure TMusic_bass.Close; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); - {$ENDIF} -end; - -function TMusic_bass.Length: real; -var - bytes: integer; -begin - Result := 60; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); - {$ENDIF} -end; - -function TMusic_bass.Position: real; -var - bytes: integer; -begin - Result := 0; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); - {$ENDIF} -end; - -function TMusic_bass.Finished: boolean; -begin - Result := false; - - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; - {$ENDIF} -end; - -procedure TMusic_bass.PlayStart; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayBack; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then - {$ENDIF} -end; - -procedure TMusic_bass.PlaySwoosh; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayChange; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayOption; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayClick; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayDrum; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayHihat; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayClap; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); - {$ENDIF} -end; - -procedure TMusic_bass.PlayShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); - {$ENDIF} -end; - -procedure TMusic_bass.StopShuffle; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); - {$ENDIF} -end; - -procedure TMusic_bass.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; -end; - -procedure TMusic_bass.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; - -end; - -//procedure TMusic_bass.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TMusic_bass.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if not BASS_RecordInit(RecordI) then - begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; - - {$ENDIF} -end; - -procedure TMusic_bass.StopCard(Card: byte); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; - {$ENDIF} -end; - -function TMusic_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - {$ELSE} - hStream := FFMPeg_StreamCreateFile(False, pchar(Name) ); - {$ENDIF} - - - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end - else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TMusic_bass.GetFFTData: TFFTData; -var -Data: TFFTData; -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - //Result := Data; - - {$ENDIF} -end; - -function TMusic_bass.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TMusic_bass.PlayCustomSound(const Index: Cardinal ); -begin - {$IFDEF useBASS} - // TODO : jb_linux replace with something other than bass - - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); - - {$ENDIF} -end; - - -{* - -Sorry guys... this is my mess :( -Im going to try and get ffmpeg to handle audio playback ( at least for linux ) -and Im going to implement it nicly along side BASS, in TMusic_bass ( where I can ) - -http://www.dranger.com/ffmpeg/ffmpeg.html -http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - -http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*} -{* -function TMusic_bass.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; -var - lFormatCtx : PAVFormatContext; -begin - -(* - if(SDL_OpenAudio(&wanted_spec, &spec) < 0) - begin - fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); - writeln( 'SDL_OpenAudio' ); - exit; - end; -*) - -(* - if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) - begin - writeln( 'Unable to open file '+ aFileName ); - exit; - end; - - // Retrieve stream information - if ( av_find_stream_info(pFormatCtx) < 0 ) - begin - writeln( 'Unable to Retrieve stream information' ); - exit; - end; -*) - -end; *} - -end. -- cgit v1.2.3 From 8c923b5b76bb17e00132a0b2b2b96de34265fc63 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 16 Oct 2007 11:27:23 +0000 Subject: modified ffmpeg usage, to use interface same as bass... still needs some tidy up, but its working. :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@515 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 2 - Game/Code/Classes/UAudio_bass.pas | 27 +- Game/Code/Classes/UMedia_dummy.pas | 276 ++++++++++++++++ Game/Code/Classes/UMusic.pas | 142 +++++--- Game/Code/Classes/UVideo.pas | 625 +++++++++++++++++++++--------------- 5 files changed, 758 insertions(+), 314 deletions(-) create mode 100644 Game/Code/Classes/UMedia_dummy.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 2a3c5cb5..959d904a 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -16,8 +16,6 @@ uses Classes, {$IFNDEF FPC} Forms, {$ENDIF} - - bass, ULog, UMusic; diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index cbeadc47..5aecfc89 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -79,7 +79,7 @@ type procedure Close; function Finished: boolean; function Length: real; - function Position: real; + function getPosition: real; procedure PlayStart; procedure PlayBack; procedure PlaySwoosh; @@ -118,17 +118,22 @@ var Pet: integer; S: integer; begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + writeln( 'TAudio_bass.InitializePlayback' ); +// Log.BenchmarkStart(4); +// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); Loaded := false; Loop := false; + + writeln( 'TAudio_bass AllocateHWND' ); {$ifdef win32} // TODO : JB_Linux ... is this needed ? :) fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function {$ENDIF} + + writeln( 'TAudio_bass BASS_Init' ); // TODO : jb_linux replace with something other than bass if not BASS_Init(1, 44100, 0, fHWND, nil) then begin @@ -139,15 +144,16 @@ begin Exit; end; - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); +// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); // config playing buffer // BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); // BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - Log.LogStatus('Loading Sounds', 'Music Initialize'); +// Log.LogStatus('Loading Sounds', 'Music Initialize'); - Log.BenchmarkStart(4); + writeln( 'TAudio_bass LoadSoundFromFile' ); +// Log.BenchmarkStart(4); LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); @@ -161,8 +167,8 @@ begin // LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - Log.BenchmarkEnd(4); - Log.LogBenchmark('--> Loading Sounds', 4); +// Log.BenchmarkEnd(4); +// Log.LogBenchmark('--> Loading Sounds', 4); end; procedure TAudio_bass.InitializeRecord; @@ -347,7 +353,7 @@ begin Result := BASS_ChannelBytes2Seconds(Bass, bytes); end; -function TAudio_bass.Position: real; +function TAudio_bass.getPosition: real; var bytes: integer; begin @@ -631,7 +637,10 @@ initialization AudioManager.add( IAudioInput( singleton_MusicBass ) ); finalization + writeln( 'UAudio_Bass - UnRegister Playback' ); AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) ); + + writeln( 'UAudio_Bass - UnRegister Input' ); AudioManager.Remove( IAudioInput( singleton_MusicBass ) ); end. diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas new file mode 100644 index 00000000..0752ab64 --- /dev/null +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -0,0 +1,276 @@ +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} + + +implementation + +uses + SysUtils, + UMusic; + + +var + singleton_dummy : IVideoPlayback; + +type + Tmedia_dummy = class( TInterfacedObject, IVideoPlayback, IAudioPlayback, IAudioInput ) + private + public + constructor create(); + function GetName: String; + + procedure init(); + + function Open( aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure MoveTo(Time: real); + function getPosition: real; + + procedure FFmpegGetFrame(Time: Extended); + procedure FFmpegDrawGL(Screen: integer); + + // IAudioInput + procedure InitializeRecord; + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); + procedure StopCard(Card: byte); + function GetFFTData: TFFTData; + + // IAudioPlayback + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + procedure Rewind; + + function Finished: boolean; + function Length: real; + + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + + end; + + + +function Tmedia_dummy.GetName: String; +begin + result := 'dummy'; +end; + + +procedure Tmedia_dummy.FFmpegGetFrame(Time: Extended); +begin +end; + +procedure Tmedia_dummy.FFmpegDrawGL(Screen: integer); +begin +end; + +constructor Tmedia_dummy.create(); +begin +end; + +procedure Tmedia_dummy.init(); +begin +end; + + +function Tmedia_dummy.Open( 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.MoveTo(Time: real); +begin +end; + +function Tmedia_dummy.getPosition: real; +begin + result := 0; +end; + +// IAudioInput +procedure Tmedia_dummy.InitializeRecord; +begin +end; + +procedure Tmedia_dummy.CaptureStart; +begin +end; + +procedure Tmedia_dummy.CaptureStop; +begin +end; + +procedure Tmedia_dummy.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +begin +end; + +procedure Tmedia_dummy.StopCard(Card: byte); +begin +end; + +function Tmedia_dummy.GetFFTData: TFFTData; +begin +end; + +// IAudioPlayback +procedure Tmedia_dummy.InitializePlayback; +begin +end; + +procedure Tmedia_dummy.SetVolume(Volume: integer); +begin +end; + +procedure Tmedia_dummy.SetMusicVolume(Volume: integer); +begin +end; + +procedure Tmedia_dummy.SetLoop(Enabled: boolean); +begin +end; + +procedure Tmedia_dummy.Rewind; +begin +end; + +function Tmedia_dummy.Finished: boolean; +begin +end; + +function Tmedia_dummy.Length: real; +begin +end; + +procedure Tmedia_dummy.PlayStart; +begin +end; + +procedure Tmedia_dummy.PlayBack; +begin +end; + +procedure Tmedia_dummy.PlaySwoosh; +begin +end; + +procedure Tmedia_dummy.PlayChange; +begin +end; + +procedure Tmedia_dummy.PlayOption; +begin +end; + +procedure Tmedia_dummy.PlayClick; +begin +end; + +procedure Tmedia_dummy.PlayDrum; +begin +end; + +procedure Tmedia_dummy.PlayHihat; +begin +end; + +procedure Tmedia_dummy.PlayClap; +begin +end; + +procedure Tmedia_dummy.PlayShuffle; +begin +end; + +procedure Tmedia_dummy.StopShuffle; +begin +end; + +function Tmedia_dummy.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +begin + result := false; +end; + +function Tmedia_dummy.LoadCustomSound(const Filename: String): Cardinal; +begin + result := 0; +end; + +procedure Tmedia_dummy.PlayCustomSound(const Index: Cardinal ); +begin +end; + + + +initialization + singleton_dummy := Tmedia_dummy.create(); + + writeln( 'UMedia_dummy - Register dummy Video_Playback' ); + AudioManager.add( IVideoPlayback( singleton_dummy ) ); + + writeln( 'UMedia_dummy - Register dummy Video_Playback' ); + AudioManager.add( IAudioPlayback( singleton_dummy ) ); + + writeln( 'UMedia_dummy - Register dummy Video_Playback' ); + AudioManager.add( IAudioInput( singleton_dummy ) ); + +finalization + AudioManager.Remove( IVideoPlayback( singleton_dummy ) ); + AudioManager.Remove( IAudioPlayback( singleton_dummy ) ); + AudioManager.Remove( IAudioInput( singleton_dummy ) ); + + +end. diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 8aa59d41..88d845f7 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -8,8 +8,7 @@ interface {$MODE Delphi} {$ENDIF} -uses Classes // UCommon - ; +uses Classes ; type TMuzyka = record @@ -94,23 +93,58 @@ type end; type - IAudioPlayback = Interface + IGenericPlayback = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] + function GetName: String; + + function Open(Name: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure MoveTo(Time: real); + function getPosition: real; + + property position : real READ getPosition WRITE MoveTo; + end; + + IVideoPlayback = Interface( IGenericPlayback ) + ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] +(* + procedure FFmpegOpenFile(FileName: pAnsiChar); + procedure FFmpegClose; + + procedure FFmpegGetFrame(Time: Extended); + procedure FFmpegDrawGL(Screen: integer); + procedure FFmpegTogglePause; + procedure FFmpegSkip(Time: Single); +*) + procedure init(); + + procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure FFmpegDrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + + end; + + IAudioPlayback = Interface( IGenericPlayback ) ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] - function GetName: String; procedure InitializePlayback; procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed +// function Open(Name: string): boolean; // true if succeed procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; +// procedure MoveTo(Time: real); +// procedure Play; +// procedure Pause; +// procedure Stop; +// procedure Close; function Finished: boolean; function Length: real; - function Position: real; +// function getPosition: real; + procedure PlayStart; procedure PlayBack; procedure PlaySwoosh; @@ -159,6 +193,7 @@ var // TODO : JB --- THESE SHOULD NOT BE GLOBAL procedure InitializeSound; +function VideoPlayback(): IVideoPlayback; function AudioPlayback(): IAudioPlayback; function AudioInput(): IAudioInput; @@ -168,21 +203,30 @@ function AudioManager: TInterfaceList; implementation uses - sysutils, - uLog; + sysutils; +// uLog; var - singleton_AudioPlayback : IAudioPlayback; - singleton_AudioInput : IAudioInput; - singleton_AudioManager : TInterfaceList; + singleton_VideoPlayback : IVideoPlayback = nil; + singleton_AudioPlayback : IAudioPlayback = nil; + singleton_AudioInput : IAudioInput = nil; + singleton_AudioManager : TInterfaceList = nil; function AudioManager: TInterfaceList; begin + if singleton_AudioManager = nil then + singleton_AudioManager := TInterfaceList.Create(); + Result := singleton_AudioManager; end; //CompressionPluginManager +function VideoPlayback(): IVideoPlayback; +begin + result := singleton_VideoPlayback; +end; + function AudioPlayback(): IAudioPlayback; begin result := singleton_AudioPlayback; @@ -195,45 +239,71 @@ end; procedure InitializeSound; var - lTmpPlayBack : IAudioPlayback; - lTmpInput : IAudioInput; - iCount : Integer; + lTmpInterface : IInterface; + iCount : Integer; begin - lTmpPlayBack := nil; - lTmpInput := nil; + lTmpInterface := nil; + + singleton_AudioPlayback := nil; + singleton_AudioInput := nil; + singleton_VideoPlayback := nil; writeln( 'InitializeSound , Enumerate Registered Audio Interfaces' ); - for iCount := 0 to singleton_AudioManager.Count - 1 do + for iCount := 0 to AudioManager.Count - 1 do begin if assigned( AudioManager[iCount] ) then begin // if this interface is a Playback, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpPlayBack ) = 0 ) AND - ( not assigned( singleton_AudioPlayback ) ) then + + if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND + ( true ) then +// ( not assigned( singleton_AudioPlayback ) ) then begin - singleton_AudioPlayback := lTmpPlayBack; + singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); end; // if this interface is a Input, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInput ) = 0 ) AND - ( not assigned( singleton_AudioInput ) ) then + if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND + ( true ) then +// ( not assigned( singleton_AudioInput ) ) then begin - singleton_AudioInput := lTmpInput; + singleton_AudioInput := IAudioInput( lTmpInterface ); end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND + ( true ) then +// ( not assigned( singleton_VideoPlayback ) ) then + begin + singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); + end; + end; end; - writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); - writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + if VideoPlayback <> nil then + begin + writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); + end; + + if AudioPlayback <> nil then + begin + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + // Log.LogStatus('Initializing Playback ('+AudioPlayback.GetName+')', 'InitializeSound'); + AudioPlayback.InitializePlayback; + end; + + if AudioInput <> nil then + begin + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + +// Log.LogStatus('Initializing Record ('+AudioPlayback.GetName+')', 'InitializeSound'); + AudioInput.InitializeRecord; + end; - // Initialize Playback - Log.LogStatus('Initializing Playback ('+AudioPlayback.GetName+')', 'InitializeSound'); - AudioPlayback.InitializePlayback; + writeln( 'InitializeSound DONE' ); - // Initialize Input - Log.LogStatus('Initializing Record ('+AudioPlayback.GetName+')', 'InitializeSound'); - AudioInput.InitializeRecord; end; initialization diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index ed1e5fe3..6e16a7a3 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -22,6 +22,14 @@ interface {$MODE DELPHI} {$ENDIF} +(* + + look into + av_read_play + +*) + +implementation uses SDL, UGraphicClasses, @@ -37,56 +45,69 @@ uses SDL, dialogs, {$endif} {$ENDIF} - UIni; + UIni, + UMusic; -procedure Init; -procedure FFmpegOpenFile(FileName: pAnsiChar); -procedure FFmpegClose; -procedure FFmpegGetFrame(Time: Extended); -procedure FFmpegDrawGL(Screen: integer); -procedure FFmpegTogglePause; -procedure FFmpegSkip(Time: Single); -{ - @author(Jay Binks ) - @created(2007-10-09) - @lastmod(2007-10-09) +var + singleton_VideoFFMpeg : IVideoPlayback; - @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) +type + TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback ) + private + fVideoOpened , + fVideoPaused : Boolean; - translated from "Setting Up the Audio" section at - http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - } -function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + fVideoTex : glUint; + fVideoSkipTime : Single; + + fTexData : array of Byte; + + VideoFormatContext: PAVFormatContext; + + VideoStreamIndex , + AudioStreamIndex : Integer; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + myBuffer: pByte; + + TexX, TexY, dataX, dataY: Cardinal; + + ScaledVideoWidth, ScaledVideoHeight: Real; + VideoAspect: Real; + VideoTextureU, VideoTextureV: Real; + VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; + + + WantedAudioCodecContext, + AudioCodecContext : PSDL_AudioSpec; + aCodecCtx : PAVCodecContext; + + + function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + public + constructor create(); + function GetName: String; + + procedure init(); + + function Open( aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure MoveTo(Time: real); + function getPosition: real; + + procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure FFmpegDrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + + end; -var - VideoOpened, VideoPaused: Boolean; - VideoFormatContext: PAVFormatContext; - VideoStreamIndex , - AudioStreamIndex : Integer; - VideoCodecContext: PAVCodecContext; - VideoCodec: PAVCodec; - AVFrame: PAVFrame; - AVFrameRGB: PAVFrame; - myBuffer: pByte; - VideoTex: glUint; - TexX, TexY, dataX, dataY: Cardinal; - TexData: array of Byte; - ScaledVideoWidth, ScaledVideoHeight: Real; - VideoAspect: Real; - VideoTextureU, VideoTextureV: Real; - VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; - VideoSkipTime: Single; - - - WantedAudioCodecContext, - AudioCodecContext : PSDL_AudioSpec; - aCodecCtx : PAVCodecContext; - -implementation {$ifdef DebugDisplay} //{$ifNdef win32} @@ -102,15 +123,10 @@ end; { ------------------------------------------------------------------------------ asdf ------------------------------------------------------------------------------ } -procedure Init; -begin - av_register_all; - VideoOpened:=False; - VideoPaused:=False; - - glGenTextures(1, PglUint(@VideoTex)); - SetLength(TexData,0); +function TVideoPlayback_ffmpeg.GetName: String; +begin + result := 'FFMpeg'; end; { @@ -126,7 +142,7 @@ end; translated from "Setting Up the Audio" section at http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html } -function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; +function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; var i : integer; st : pAVStream; @@ -164,202 +180,10 @@ begin (aFirstVideoStream > -1) ; // Didn't find a video stream end; -procedure FFmpegOpenFile(FileName: pAnsiChar); -var errnum, i, x,y: Integer; - lStreamsCount : Integer; - -begin - VideoOpened := False; - VideoPaused := False; - VideoTimeBase := 0; - VideoTime := 0; - LastFrameTime := 0; - TimeDifference := 0; - VideoFormatContext := 0; - - writeln( Filename ); - - errnum := av_open_input_file(VideoFormatContext, FileName, Nil, 0, Nil); - writeln( 'Errnum : ' +inttostr( errnum )); - if(errnum <> 0) then - begin -{$ifdef DebugDisplay} - case errnum of - AVERROR_UNKNOWN: showmessage('failed to open file '+Filename+#13#10+'AVERROR_UNKNOWN'); - AVERROR_IO: showmessage('failed to open file '+Filename+#13#10+'AVERROR_IO'); - AVERROR_NUMEXPECTED: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NUMEXPECTED'); - AVERROR_INVALIDDATA: showmessage('failed to open file '+Filename+#13#10+'AVERROR_INVALIDDATA'); - AVERROR_NOMEM: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOMEM'); - AVERROR_NOFMT: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOFMT'); - AVERROR_NOTSUPP: showmessage('failed to open file '+Filename+#13#10+'AVERROR_NOTSUPP'); - else showmessage('failed to open file '+Filename+#13#10+'Error number: '+inttostr(Errnum)); - end; -{$ENDIF} - Exit; - end - else - begin - VideoStreamIndex := -1; - AudioStreamIndex := -1; - - // Find which stream contains the video - if( av_find_stream_info(VideoFormatContext) >= 0 ) then - begin - find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); - - writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); - writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); - end; - aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; - - WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; - WantedAudioCodecContext.format := AUDIO_S16SYS; - WantedAudioCodecContext.channels := aCodecCtx^.channels; - WantedAudioCodecContext.silence := 0; - WantedAudioCodecContext.samples := 1024;//SDL_AUDIO_BUFFER_SIZE; -// WantedAudioCodecContext.callback := audio_callback; - WantedAudioCodecContext.userdata := aCodecCtx; - - -(* - if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then - begin - writeln( 'Could not do SDL_OpenAudio' ); - exit; - end; -*) - - if(VideoStreamIndex >= 0) then - begin - VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; - VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); - end - else - begin -{$ifdef DebugDisplay} - showmessage('found no video stream'); -{$ENDIF} - av_close_input_file(VideoFormatContext); - Exit; - end; - - - if(VideoCodec<>Nil) then - begin - errnum:=avcodec_open(VideoCodecContext, VideoCodec); - end else begin -{$ifdef DebugDisplay} - showmessage('no matching codec found'); -{$ENDIF} - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - Exit; - end; - if(errnum >=0) then - begin -{$ifdef DebugDisplay} - showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ - ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ - ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ - ' 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; - end; - myBuffer:=Nil; - if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then - begin - myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, - VideoCodecContext^.height)); - end; - if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, - VideoCodecContext^.width, VideoCodecContext^.height) - else begin -{$ifdef DebugDisplay} - showmessage('failed to allocate video buffer'); -{$endif} - av_free(AVFrameRGB); - av_free(AVFrame); - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - Exit; - end; - if errnum >=0 then - begin - VideoOpened:=True; - - TexX := VideoCodecContext^.width; - TexY := VideoCodecContext^.height; - dataX := Round(Power(2, Ceil(Log2(TexX)))); - dataY := Round(Power(2, Ceil(Log2(TexY)))); - SetLength(TexData,dataX*dataY*3); - // calculate some information for video display - VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; - if (VideoAspect = 0) then - VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height - else - VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; - if VideoAspect >= 4/3 then - begin - ScaledVideoWidth:=800.0; - ScaledVideoHeight:=800.0/VideoAspect; - end else - begin - ScaledVideoHeight:=600.0; - ScaledVideoWidth:=600.0*VideoAspect; - end; - VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; - // hack to get reasonable timebase for divx -{$ifdef DebugDisplay} - showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); -{$endif} - if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps - begin - VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; - while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; - VideoTimeBase:=1/VideoTimeBase; - end; -{$ifdef DebugDisplay} - showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); - - if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then - showmessage('you are trying to play a rather large video'+#13#10+ - 'be prepared to experience some timing problems'); -{$endif} - end; - end; -end; - -procedure FFmpegClose; -begin - if VideoOpened then begin - av_free(myBuffer); - av_free(AVFrameRGB); - av_free(AVFrame); - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - SetLength(TexData,0); - VideoOpened:=False; - end; -end; -procedure FFmpegTogglePause; -begin - if VideoPaused then VideoPaused:=False - else VideoPaused:=True; -end; -procedure FFmpegSkip(Time: Single); -begin - VideoSkiptime:=Time; - if VideoSkipTime > 0 then begin - av_seek_frame(VideoFormatContext,-1,Floor((VideoSkipTime)*1500000),0); - VideoTime:=VideoSkipTime; - end; -end; -procedure FFmpegGetFrame(Time: Extended); +procedure TVideoPlayback_ffmpeg.FFmpegGetFrame(Time: Extended); var FrameFinished: Integer; AVPacket: TAVPacket; @@ -372,13 +196,13 @@ var const FRAMEDROPCOUNT=3; begin - if not VideoOpened then Exit; + if not fVideoOpened then Exit; - if VideoPaused then Exit; - - myTime:=Time+VideoSkipTime; - TimeDifference:=myTime-VideoTime; - DropFrame:=False; + if fVideoPaused then Exit; + + myTime := Time + fVideoSkipTime; + TimeDifference := myTime - VideoTime; + DropFrame := False; {$IFDEF DebugDisplay} showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ @@ -404,7 +228,8 @@ begin Exit;// we don't need a new frame now end; - + + VideoTime:=VideoTime+VideoTimeBase; TimeDifference:=myTime-VideoTime; if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames @@ -415,37 +240,52 @@ begin {$endif} {$IFDEF DebugDisplay} + showmessage('skipping frames'+#13#10+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); + {$endif} -// av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time*VideoTimeBase),0); +// av_seek_frame(VideoFormatContext.,VideoStreamIndex,Floor(Time*VideoTimeBase),0); { av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; DropFrame:=True; end; + // av_init_packet(@AVPacket); + AVPacket.data := nil; av_init_packet( AVPacket ); // JB-ffmpeg - + + FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) // while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do while (FrameFinished=0) and (av_read_frame(VideoFormatContext, AVPacket)>=0) do // JB-ffmpeg begin + + // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then // errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished , AVPacket.data, AVPacket.size); errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg - + // release internal packet structure created by av_read_frame // av_free_packet(PAVPacket(@AVPacket)); - av_free_packet( AVPacket ); // JB-ffmpeg + + try + if AVPacket.data <> nil then + av_free_packet( AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; + end; - + + if DropFrame then for droppedFrames:=1 to FRAMEDROPCOUNT do begin FrameFinished:=0; @@ -485,12 +325,12 @@ begin linesize := AVFrameRGB^.linesize[0]; for y:=0 to TexY-1 do begin - System.Move(FrameDataPtr[y*linesize],TexData[3*y*dataX],linesize); + System.Move(FrameDataPtr[y*linesize],fTexData[3*y*dataX],linesize); end; // generate opengl texture out of whatever we got - glBindTexture(GL_TEXTURE_2D, VideoTex); - glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, TexData); + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, fTexData); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); {$ifdef DebugFrames} @@ -501,20 +341,21 @@ begin end; end; -procedure FFmpegDrawGL(Screen: integer); +procedure TVideoPlayback_ffmpeg.FFmpegDrawGL(Screen: integer); begin // have a nice black background to draw on (even if there were errors opening the vid) - if Screen=1 then begin + 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 VideoOpened then Exit; + if not fVideoOpened then Exit; glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glColor4f(1, 1, 1, 1); - glBindTexture(GL_TEXTURE_2D, VideoTex); + glBindTexture(GL_TEXTURE_2D, fVideoTex); glbegin(gl_quads); glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); @@ -525,7 +366,8 @@ begin glDisable(GL_BLEND); {$ifdef Info} - if VideoSkipTime+VideoTime+VideoTimeBase < 0 then begin + if VideoSkipTime+VideoTime+VideoTimeBase < 0 then + begin glColor4f(0.7, 1, 0.3, 1); SetFontStyle (1); SetFontItalic(False); @@ -558,4 +400,253 @@ begin {$endif} end; +constructor TVideoPlayback_ffmpeg.create(); +begin + writeln( 'UVideo_FFMpeg - TVideoPlayback_ffmpeg.create()' ); + + writeln( 'UVideo_FFMpeg - av_register_all' ); + av_register_all; + + fVideoOpened := False; + fVideoPaused := False; + +end; + +procedure TVideoPlayback_ffmpeg.init(); +begin + writeln( 'UVideo_FFMpeg - glGenTextures(1, PglUint(@fVideoTex))' ); + glGenTextures(1, PglUint(@fVideoTex)); + + writeln( 'UVideo_FFMpeg - SetLength(fTexData,0)' ); + SetLength(fTexData,0); +end; + + +function TVideoPlayback_ffmpeg.Open( aFileName : string): boolean; // true if succeed +var + errnum, i, x,y: Integer; + lStreamsCount : Integer; + +begin + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + LastFrameTime := 0; + TimeDifference := 0; + VideoFormatContext := 0; + + writeln( aFileName ); + + errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil); + writeln( 'Errnum : ' +inttostr( errnum )); + if(errnum <> 0) then + begin +{$ifdef DebugDisplay} + case errnum of + AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN'); + AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO'); + AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED'); + AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA'); + AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM'); + AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT'); + AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP'); + else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum)); + end; +{$ENDIF} + Exit; + end + else + begin + VideoStreamIndex := -1; + AudioStreamIndex := -1; + + // Find which stream contains the video + if( av_find_stream_info(VideoFormatContext) >= 0 ) then + begin + find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); + + writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); + writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); + end; + aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; + +(* + WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; + WantedAudioCodecContext.format := AUDIO_S16SYS; + WantedAudioCodecContext.channels := aCodecCtx^.channels; + WantedAudioCodecContext.silence := 0; + WantedAudioCodecContext.samples := 1024;//SDL_AUDIO_BUFFER_SIZE; +// WantedAudioCodecContext.callback := audio_callback; + WantedAudioCodecContext.userdata := aCodecCtx; +*) + +(* + if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then + begin + writeln( 'Could not do SDL_OpenAudio' ); + exit; + end; +*) + + if(VideoStreamIndex >= 0) then + begin + VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; + VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); + end + else + begin +{$ifdef DebugDisplay} + showmessage('found no video stream'); +{$ENDIF} + av_close_input_file(VideoFormatContext); + Exit; + end; + + + if(VideoCodec<>Nil) then + begin + errnum:=avcodec_open(VideoCodecContext, VideoCodec); + end else begin +{$ifdef DebugDisplay} + showmessage('no matching codec found'); +{$ENDIF} + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(errnum >=0) then + begin +{$ifdef DebugDisplay} + showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ + ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + ' 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; + end; + myBuffer:=Nil; + if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then + begin + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, + VideoCodecContext^.height)); + end; + if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, + VideoCodecContext^.width, VideoCodecContext^.height) + else begin +{$ifdef DebugDisplay} + showmessage('failed to allocate video buffer'); +{$endif} + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if errnum >=0 then + begin + fVideoOpened:=True; + + TexX := VideoCodecContext^.width; + TexY := VideoCodecContext^.height; + dataX := Round(Power(2, Ceil(Log2(TexX)))); + dataY := Round(Power(2, Ceil(Log2(TexY)))); + SetLength(fTexData,dataX*dataY*3); + // calculate some information for video display + VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; + if (VideoAspect = 0) then + VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height + else + VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; + if VideoAspect >= 4/3 then + begin + ScaledVideoWidth:=800.0; + ScaledVideoHeight:=800.0/VideoAspect; + end else + begin + ScaledVideoHeight:=600.0; + ScaledVideoWidth:=600.0*VideoAspect; + end; + VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; + // hack to get reasonable timebase for divx +{$ifdef DebugDisplay} + showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); +{$endif} + if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps + begin + VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; + while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; + VideoTimeBase:=1/VideoTimeBase; + end; +{$ifdef DebugDisplay} + showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); + + if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then + showmessage('you are trying to play a rather large video'+#13#10+ + 'be prepared to experience some timing problems'); +{$endif} + end; + end; +end; + +procedure TVideoPlayback_ffmpeg.Close; +begin + if fVideoOpened then + begin + av_free(myBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + + SetLength(fTexData,0); + + 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.MoveTo(Time: real); +begin + fVideoSkipTime := Time; + + if fVideoSkipTime > 0 then + begin + av_seek_frame(VideoFormatContext,-1,Floor((fVideoSkipTime)*1500000),0); + + VideoTime := fVideoSkipTime; + end; +end; + +function TVideoPlayback_ffmpeg.getPosition: real; +begin + result := 0; +end; + +initialization + singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); + + writeln( 'UVideo_FFMpeg - Register Playback' ); + AudioManager.add( IVideoPlayback( singleton_VideoFFMpeg ) ); + + +finalization + AudioManager.Remove( IVideoPlayback( singleton_VideoFFMpeg ) ); + + end. -- cgit v1.2.3 From f392b84c00dbcefa6f0d0d50b208f748d3dc940b Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 16 Oct 2007 11:44:55 +0000 Subject: fixed WinLaz build.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@517 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_bass.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 5aecfc89..985eede5 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -30,6 +30,7 @@ uses URecord, UIni, UMain, + UCommon, UThemes; const -- cgit v1.2.3 From 4231c33ad7c7765fd3851c5c7168f8c7d367deef Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 16 Oct 2007 23:19:11 +0000 Subject: nearly finished Cores loading procs Add PluginLoader Unit to implent new PluginLoader Reordered Delphi .dpr uses clausel git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@519 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 216 +++++++++++++++++++++++++++++++++--- Game/Code/Classes/UCoreModule.pas | 21 ++-- Game/Code/Classes/uPluginLoader.pas | 7 ++ 3 files changed, 219 insertions(+), 25 deletions(-) create mode 100644 Game/Code/Classes/uPluginLoader.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 990ee7ab..de44fb3b 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -26,13 +26,18 @@ type //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; + sReportError: THandle; + sReportDebug: THandle; + sShowMessage: THandle; + sRetranslate: THandle; + sReloadTextures: THandle; + sGetModuleInfo: THandle; Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; @@ -69,6 +74,10 @@ type 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 + + //--------------- //Main Methods to control the Core: //--------------- @@ -81,17 +90,21 @@ type // Hook and Service Procs: //-------------- Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - {Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)} + Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook + Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook + Function GetModuleInfo(wParam, lParam: DWord): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam end; var Core: TCore; implementation +uses SysUtils, {$IFDEF win32} -uses Windows; -{$ENDIF} +Windows +{$ENDIF}; //------------- // Create - Creates Class + Hook and Service Manager @@ -102,6 +115,9 @@ begin Version := cVersion; CurExecuted := 0; + LastErrorReporter := ''; + LastErrorString := ''; + Hooks := THookManager.Create(50); Services := TServiceManager.Create; end; @@ -128,9 +144,88 @@ begin Except noError := False; end; + + if (noError) then + begin //Init + Try + noError := Init; + Except + noError := False; + end; + + If noError then + begin + //Call Translate Hook + noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0); + + If noError then + begin //Calls LoadTextures Hook + noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0); + + if noError then + begin //Calls Loading Finished Hook + noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0); + + If noError then + begin + //Start MainLoop + While noError do + begin + noError := MainLoop; + // to-do : Call Display Draw here + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); + end; + + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); + end; end else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar(''))); + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); + end; + + //DeInit + DeInit; end; //------------- @@ -138,7 +233,7 @@ end; //------------- Function TCore.MainLoop: Boolean; begin - Result := True; + Result := False; end; @@ -149,11 +244,17 @@ Function TCore.GetModules: Boolean; var I: Integer; begin - For I := 0 to high(Modules) do - begin - Modules[I].NeedsDeInit := False; - Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; - Modules[I].Module.Info(@Modules[I].Info); + Result := False; + try + For I := 0 to high(Modules) do + begin + Modules[I].NeedsDeInit := False; + Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; + Modules[I].Module.Info(@Modules[I].Info); + end; + Result := True; + except + ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); end; end; @@ -169,7 +270,13 @@ begin I := 0; While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do begin - Result := Modules[I].Module.Load; + try + Result := Modules[I].Module.Load; + except + Result := False; + ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + Inc(I); end; end; @@ -186,7 +293,14 @@ begin I := 0; While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do begin - Result := Modules[I].Module.Init; + try + Result := Modules[I].Module.Init; + except + Result := False; + ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + + Modules[I].NeedsDeInit := Result; Inc(I); end; end; @@ -227,13 +341,19 @@ 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'); - sReportDebug := Services.AddService('Core/ReportDebug'); + + 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); end; //------------- @@ -255,7 +375,7 @@ begin end; //------------- -//Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) //------------- Function TCore.ShowMessage(wParam, lParam: DWord): integer; var Params: Cardinal; @@ -280,4 +400,64 @@ begin // to-do : write ShowMessage for other OSes end; +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +Function TCore.ReportError(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hError, wParam, lParam); + + //Update LastErrorReporter and LastErrorString + LastErrorReporter := String(PChar(Ptr(lParam))); + LastErrorString := String(PChar(Ptr(wParam))); +end; + +//------------- +// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +Function TCore.ReportDebug(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); +end; + +//------------- +// Calls Translate hook +//------------- +Function TCore.Retranslate(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hTranslate, 0, 1); +end; + +//------------- +// Calls LoadTextures hook +//------------- +Function TCore.ReloadTextures(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hLoadTextures, 0, 1); +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, lParam: DWord): integer; +begin + if (ptr(lParam) = nil) then + begin + Result := Length(Modules); + end + else + begin + Try + For Result := 0 to High(Modules) do + begin + AModuleInfo(ptr(lParam))[Result].Name := Modules[Result].Info.Name; + AModuleInfo(ptr(lParam))[Result].Version := Modules[Result].Info.Version; + AModuleInfo(ptr(lParam))[Result].Description := Modules[Result].Info.Description; + end; + Except + Result := -1; + end; + end; +end; + end. \ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index 4d36f925..6fca5d37 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -6,19 +6,13 @@ interface Dummy Class that has Methods that will be called from Core In the Best case every Piece of this Software is a Module *********************} +uses UPluginDefs; {$IFDEF FPC} {$MODE Delphi} {$ENDIF} type - PModuleInfo = ^TModuleInfo; - TModuleInfo = record - Name: String; - Version: LongWord; - Description: String; - end; - TCoreModule = class public //Function that gives some Infos about the Module to the Core @@ -44,6 +38,10 @@ type //Deinit is in backwards Initing Order //If False is Returned this will cause a Forced Exit Procedure DeInit; virtual; + + //Is Called if this Module will be unloaded and has been created + //Should be used to Free Memory + Procedure Free; virtual; end; cCoreModule = class of TCoreModule; @@ -102,4 +100,13 @@ begin //Dummy ftw!! end; +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Procedure TCoreModule.Free; +begin + //Dummy ftw!! +end; + end. \ No newline at end of file diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas new file mode 100644 index 00000000..929fd84e --- /dev/null +++ b/Game/Code/Classes/uPluginLoader.pas @@ -0,0 +1,7 @@ +unit uPluginLoader; + +interface + +implementation + +end. -- cgit v1.2.3 From 59074886c5609310cbafcbae19b0a847a1c2bd0e Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 24 Oct 2007 12:05:05 +0000 Subject: comment this.. oops git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@524 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 6e16a7a3..05496fbc 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -83,7 +83,7 @@ type WantedAudioCodecContext, AudioCodecContext : PSDL_AudioSpec; - aCodecCtx : PAVCodecContext; + aCodecCtx : PAVCodecContext; function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; @@ -471,16 +471,19 @@ begin end; aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; -(* + if aCodecCtx <> nil then + begin + WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; - WantedAudioCodecContext.format := AUDIO_S16SYS; - WantedAudioCodecContext.channels := aCodecCtx^.channels; - WantedAudioCodecContext.silence := 0; +// WantedAudioCodecContext.format := AUDIO_S16SYS; +// WantedAudioCodecContext.channels := aCodecCtx^.channels; +(* WantedAudioCodecContext.silence := 0; WantedAudioCodecContext.samples := 1024;//SDL_AUDIO_BUFFER_SIZE; // WantedAudioCodecContext.callback := audio_callback; WantedAudioCodecContext.userdata := aCodecCtx; *) + end; (* if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then begin -- cgit v1.2.3 From cdf2eb843e60cb4712080430a9f43f8e68e26069 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 24 Oct 2007 12:14:03 +0000 Subject: modifed bitmap fonts to have alpha channel, after conversation with blindy. modified ultrastar.lpr to get linux version running as it should be ( after mods I did in windows ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@525 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 110 +++++++++++++++++++++---------------------- 1 file changed, 55 insertions(+), 55 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 88d845f7..f3342625 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -94,13 +94,13 @@ type type IGenericPlayback = Interface - ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] - function GetName: String; - - function Open(Name: string): boolean; // true if succeed - procedure Close; - - procedure Play; + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] + function GetName: String; + + function Open(Name: string): boolean; // true if succeed + procedure Close; + + procedure Play; procedure Pause; procedure Stop; @@ -108,24 +108,24 @@ type function getPosition: real; property position : real READ getPosition WRITE MoveTo; - end; + end; IVideoPlayback = Interface( IGenericPlayback ) - ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] -(* - procedure FFmpegOpenFile(FileName: pAnsiChar); + ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] +(* + procedure FFmpegOpenFile(FileName: pAnsiChar); procedure FFmpegClose; procedure FFmpegGetFrame(Time: Extended); procedure FFmpegDrawGL(Screen: integer); procedure FFmpegTogglePause; procedure FFmpegSkip(Time: Single); -*) - procedure init(); - - procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC +*) + procedure init(); + + procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC procedure FFmpegDrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC - + end; IAudioPlayback = Interface( IGenericPlayback ) @@ -212,13 +212,13 @@ var singleton_AudioInput : IAudioInput = nil; singleton_AudioManager : TInterfaceList = nil; - -function AudioManager: TInterfaceList; -begin - if singleton_AudioManager = nil then - singleton_AudioManager := TInterfaceList.Create(); - - Result := singleton_AudioManager; + +function AudioManager: TInterfaceList; +begin + if singleton_AudioManager = nil then + singleton_AudioManager := TInterfaceList.Create(); + + Result := singleton_AudioManager; end; //CompressionPluginManager @@ -234,7 +234,7 @@ end; function AudioInput(): IAudioInput; begin - result := singleton_AudioInput; + result := singleton_AudioInput; end; procedure InitializeSound; @@ -253,33 +253,33 @@ begin begin if assigned( AudioManager[iCount] ) then begin - // if this interface is a Playback, then set it as the default used - - if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND - ( true ) then + // if this interface is a Playback, then set it as the default used + + if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND + ( true ) then // ( not assigned( singleton_AudioPlayback ) ) then begin - singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); - end; - - // if this interface is a Input, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND - ( true ) then -// ( not assigned( singleton_AudioInput ) ) then + singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); + end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND + ( true ) then +// ( not assigned( singleton_AudioInput ) ) then begin - singleton_AudioInput := IAudioInput( lTmpInterface ); - end; - - // if this interface is a Input, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND - ( true ) then -// ( not assigned( singleton_VideoPlayback ) ) then + singleton_AudioInput := IAudioInput( lTmpInterface ); + end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND + ( true ) then +// ( not assigned( singleton_VideoPlayback ) ) then begin - singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); - end; - - end; - end; + singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); + end; + + end; + end; if VideoPlayback <> nil then @@ -307,14 +307,14 @@ begin end; initialization -begin - writeln('Init AudioManager'); - singleton_AudioManager := TInterfaceList.Create(); -end; - -finalization - writeln('Finalize AudioManager'); - singleton_AudioManager.clear; +begin + writeln('Init AudioManager'); + singleton_AudioManager := TInterfaceList.Create(); +end; + +finalization + writeln('Finalize AudioManager'); + singleton_AudioManager.clear; FreeAndNil( singleton_AudioManager ); end. -- cgit v1.2.3 From 9a144f3cc3b9fbed5b07ffc3a05c5449d638d3ae Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 25 Oct 2007 06:59:28 +0000 Subject: minor changes and fixes for USDX on linux. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@526 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 2675 ++++++++++++++++++------------------ Game/Code/Classes/UMain.pas | 7 +- Game/Code/Classes/UMedia_dummy.pas | 50 +- Game/Code/Classes/UVideo.pas | 58 +- 4 files changed, 1410 insertions(+), 1380 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 473e9017..2a5528b8 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,1326 +1,1349 @@ -unit UDraw; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -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; NrCzesci: integer); -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); - -// TimeBar -procedure SingDrawTimeBar(); - -//Draw Editor NoteLines -procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} - windows, - {$ELSE} - lclintf, - {$ENDIF} - OpenGL12, - 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 >= 1 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 - Pet: integer; -begin; -// Log.LogStatus('Oscilloscope', 'SingDraw'); - glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - - glBegin(GL_LINE_STRIP); - glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); - for Pet := 2 to Sound[NrSound].n div 1 do begin - glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), - -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); - end; - glEnd; -end; - -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -var - Pet: integer; -begin - glEnable(GL_BLEND); - glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); - glBegin(GL_LINES); - for Pet := 0 to 9 do begin - glVertex2f(Left, Top + Pet * Space); - glVertex2f(Right, Top + Pet * Space); - end; - glEnd; - glDisable(GL_BLEND); -end; - -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); -var - Pet: integer; - TempR: real; -begin - TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - glEnable(GL_BLEND); - glBegin(GL_LINES); - for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin - if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then - glColor4f(0, 0, 0, 1) - else - glColor4f(0, 0, 0, 0.3); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); - glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); - end; - glEnd; - glDisable(GL_BLEND); -end; - -// draw blank Notebars -procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: 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 NrCzesci - but it's always set to zero -// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 - NrCzesci := 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - - {$IFDEF FPC} -(* - writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); - writeln( 'UDRAW : ' + floattostr( lTmpB ) ); - writeln( '' ); -*) - {$ENDIF} - - if ( lTmpA > 0 ) AND - ( lTmpB > 0 ) THEN - begin - TempR := lTmpA / lTmpB; - end - else - begin - TempR := 0; - end; - - - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - - - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case Wartosc of - 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - 2: 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 == ende, schluss - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge - - 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); -var - TempR: real; - Rec: TRecR; - N: integer; - R: real; - G: real; - B: real; - 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].IlNut > 0 then - begin - TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); - for N := 0 to Player[NrGracza].HighNut do - begin - with Player[NrGracza].Nuta[N] do - begin - // Left part of note - Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; - - // draw the left part - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; - - // (nowe) - dunno - if (Start+Dlugosc-1 = Czas.AktBeatD) then - Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); - if not (Start+Dlugosc-1 = Czas.AktBeatD) then - - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - end; - end; // with - end; // for - // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit - // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ - - // passing on NrGracza... hope this is really something like the player-number, not only - // some kind of weird index into a colour-table - - if (Ini.EffectSing=1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); - end; // if -end; - -//draw Note glow -procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); -var - Rec: TRecR; - Pet: integer; - TempR: real; - R,G,B: real; - X1, X2, X3, X4: real; - W, H: real; - - lTmpA , - lTmpB : real; -begin - if (Player[NrGracza].ScoreTotalI >= 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - - {$IFDEF FPC} -{* - writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); - writeln( 'UDRAW : ' + floattostr( lTmpB ) ); - writeln( '' ); -*} - {$ENDIF} - - if ( lTmpA > 0 ) AND - ( lTmpB > 0 ) THEN - begin - TempR := lTmpA / lTmpB; - end - else - begin - TempR := 0; - end; - - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - if not FreeStyle then begin - // begin: 14, 20 - // easy: 6, 11 - W := NotesW * 2 + 2; - H := NotesH * 1.5 + 3.5; - - X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie - X1 := X2-W; - - X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie - X4 := X3+W; - - // left - Rec.Left := X1; - Rec.Right := X2; - Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; - Rec.Bottom := Rec.Top + 2 * H; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 - Pet: 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 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; - - // Draw Lyrics - ScreenSing.Lyrics.Draw(Czas.MidBeat); - - // todo: Lyrics -{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * -// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes - end; - - if (PlayersPlay = 2) then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(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; - - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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 - Pet: 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(Czas.MidBeat); - - // todo: Lyrics -{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; - if BarFrom > 40 then BarFrom := 40; - if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 - SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); - end; - - if (PlayersPlay = 2) then begin - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - end; - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - end; - - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - end; - - if PlayerInfo.Playerinfo[2].Enabled then - begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerCzesc(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 - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - - if ScreenAct = 1 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerCzesc(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: -// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); -var - Rec: TRecR; - Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin - for Pet := 0 to HighNut do begin - with Nuta[Pet] do begin - - // Golden Note Patch - case Wartosc of - 0: glColor4f(1, 1, 1, 0.35); - 1: glColor4f(1, 1, 1, 0.85); - 2: glColor4f(1, 1, 0.3, 0.85); - end; // case - - - - // lewa czesc - left part - Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; -begin - x := Theme.Sing.StaticTimeProgress.x; - y := Theme.Sing.StaticTimeProgress.y; - width:= Theme.Sing.StaticTimeProgress.w; - height:= Theme.Sing.StaticTimeProgress.h; - - glColor4f(Theme.Sing.StaticTimeProgress.ColR, - Theme.Sing.StaticTimeProgress.ColG, - Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - - glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(x,y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 0); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y); - glTexCoord2f((width*(Czas.Teraz/Czas.Razem))/8, 1); glVertex2f(x+width*(Czas.Teraz/Czas.Razem), y+height); - glTexCoord2f(0, 1); glVertex2f(x, y+height); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1,1,1,1); -end; - -end. - +unit UDraw; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +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; NrCzesci: integer); +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +//Draw Editor NoteLines +procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGL12, + 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 >= 1 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 + Pet: integer; +begin; +// Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } + + glBegin(GL_LINE_STRIP); + glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + for Pet := 2 to Sound[NrSound].n div 1 do begin + glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), + -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + end; + glEnd; +end; + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Pet: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Pet := 0 to 9 do begin + glVertex2f(Left, Top + Pet * Space); + glVertex2f(Right, Top + Pet * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +var + Pet: integer; + TempR: real; +begin + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin + if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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 NrCzesci - but it's always set to zero +// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 + NrCzesci := 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + {$IFDEF FPC} +(* + writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); + writeln( 'UDRAW : ' + floattostr( lTmpB ) ); + writeln( '' ); +*) + {$ENDIF} + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case Wartosc of + 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + 2: 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 == ende, schluss + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge + + 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R: real; + G: real; + B: real; + 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].IlNut > 0 then + begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do + begin + with Player[NrGracza].Nuta[N] do + begin + // Left part of note + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; // with + end; // for + // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit + // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + + // passing on NrGracza... hope this is really something like the player-number, not only + // some kind of weird index into a colour-table + + if (Ini.EffectSing=1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; + + lTmpA , + lTmpB : real; +begin + if (Player[NrGracza].ScoreTotalI >= 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + {$IFDEF FPC} +{* + writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); + writeln( 'UDRAW : ' + floattostr( lTmpB ) ); + writeln( '' ); +*} + {$ENDIF} + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 + Pet: 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 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; + + // Draw Lyrics + ScreenSing.Lyrics.Draw(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(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; + + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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 + Pet: 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(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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: +// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + + // Golden Note Patch + case Wartosc of + 0: glColor4f(1, 1, 1, 0.35); + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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 ( Czas.Teraz > 0 ) AND + ( Czas.Razem > 0 ) THEN + BEGIN + lTmp := Czas.Teraz/Czas.Razem; + glTexCoord2f((width*Czas.Teraz/Czas.Razem)/8, 0); + glVertex2f(x+width*Czas.Teraz/Czas.Razem, y); + + glTexCoord2f((width*Czas.Teraz/Czas.Razem)/8, 1); + glVertex2f(x+width*Czas.Teraz/Czas.Razem, 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/UMain.pas b/Game/Code/Classes/UMain.pas index 40b91be7..82fb92e4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -588,9 +588,14 @@ begin // Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); // beep; + // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas + if not assigned( Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. + exit; + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do begin + for CP := 0 to PlayersPlay-1 do + begin // analyze buffer Sound[CP].AnalizujBufor; diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 0752ab64..bf3ad727 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -37,9 +37,9 @@ type procedure init(); function Open( aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; + procedure Close; + + procedure Play; procedure Pause; procedure Stop; @@ -90,7 +90,7 @@ type function Tmedia_dummy.GetName: String; begin - result := 'dummy'; + result := 'dummy'; end; @@ -104,23 +104,23 @@ end; constructor Tmedia_dummy.create(); begin -end; - -procedure Tmedia_dummy.init(); +end; + +procedure Tmedia_dummy.init(); +begin +end; + + +function Tmedia_dummy.Open( aFileName : string): boolean; // true if succeed begin -end; - - -function Tmedia_dummy.Open( aFileName : string): boolean; // true if succeed -begin result := false; -end; - -procedure Tmedia_dummy.Close; +end; + +procedure Tmedia_dummy.Close; begin end; -procedure Tmedia_dummy.Play; +procedure Tmedia_dummy.Play; begin end; @@ -138,7 +138,7 @@ end; function Tmedia_dummy.getPosition: real; begin - result := 0; + result := 0; end; // IAudioInput @@ -169,8 +169,8 @@ end; // IAudioPlayback procedure Tmedia_dummy.InitializePlayback; begin -end; - +end; + procedure Tmedia_dummy.SetVolume(Volume: integer); begin end; @@ -189,11 +189,13 @@ end; function Tmedia_dummy.Finished: boolean; begin -end; - + result := false; +end; + function Tmedia_dummy.Length: real; begin -end; + Result := 60; +end; procedure Tmedia_dummy.PlayStart; begin @@ -267,8 +269,8 @@ initialization writeln( 'UMedia_dummy - Register dummy Video_Playback' ); AudioManager.add( IAudioInput( singleton_dummy ) ); -finalization - AudioManager.Remove( IVideoPlayback( singleton_dummy ) ); +finalization + AudioManager.Remove( IVideoPlayback( singleton_dummy ) ); AudioManager.Remove( IAudioPlayback( singleton_dummy ) ); AudioManager.Remove( IAudioInput( singleton_dummy ) ); diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 05496fbc..4c27867d 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -94,9 +94,9 @@ type procedure init(); function Open( aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; + procedure Close; + + procedure Play; procedure Pause; procedure Stop; @@ -126,7 +126,7 @@ asdf function TVideoPlayback_ffmpeg.GetName: String; begin - result := 'FFMpeg'; + result := 'FFMpeg'; end; { @@ -281,7 +281,7 @@ begin av_free_packet( AVPacket ); // JB-ffmpeg except // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) - end; + end; end; @@ -402,29 +402,29 @@ end; constructor TVideoPlayback_ffmpeg.create(); begin - writeln( 'UVideo_FFMpeg - TVideoPlayback_ffmpeg.create()' ); - - writeln( 'UVideo_FFMpeg - av_register_all' ); - av_register_all; + writeln( 'UVideo_FFMpeg - TVideoPlayback_ffmpeg.create()' ); + + writeln( 'UVideo_FFMpeg - av_register_all' ); + av_register_all; fVideoOpened := False; fVideoPaused := False; -end; - -procedure TVideoPlayback_ffmpeg.init(); +end; + +procedure TVideoPlayback_ffmpeg.init(); begin - writeln( 'UVideo_FFMpeg - glGenTextures(1, PglUint(@fVideoTex))' ); + writeln( 'UVideo_FFMpeg - glGenTextures(1, PglUint(@fVideoTex))' ); glGenTextures(1, PglUint(@fVideoTex)); writeln( 'UVideo_FFMpeg - SetLength(fTexData,0)' ); SetLength(fTexData,0); -end; - - -function TVideoPlayback_ffmpeg.Open( aFileName : string): boolean; // true if succeed -var - errnum, i, x,y: Integer; +end; + + +function TVideoPlayback_ffmpeg.Open( aFileName : string): boolean; // true if succeed +var + errnum, i, x,y: Integer; lStreamsCount : Integer; begin @@ -474,7 +474,7 @@ begin if aCodecCtx <> nil then begin - WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; +// WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; // WantedAudioCodecContext.format := AUDIO_S16SYS; // WantedAudioCodecContext.channels := aCodecCtx^.channels; (* WantedAudioCodecContext.silence := 0; @@ -591,10 +591,10 @@ begin 'be prepared to experience some timing problems'); {$endif} end; - end; -end; - -procedure TVideoPlayback_ffmpeg.Close; + end; +end; + +procedure TVideoPlayback_ffmpeg.Close; begin if fVideoOpened then begin @@ -610,8 +610,8 @@ begin fVideoOpened:=False; end; end; - -procedure TVideoPlayback_ffmpeg.Play; + +procedure TVideoPlayback_ffmpeg.Play; begin end; @@ -638,7 +638,7 @@ end; function TVideoPlayback_ffmpeg.getPosition: real; begin - result := 0; + result := 0; end; initialization @@ -648,8 +648,8 @@ initialization AudioManager.add( IVideoPlayback( singleton_VideoFFMpeg ) ); -finalization - AudioManager.Remove( IVideoPlayback( singleton_VideoFFMpeg ) ); +finalization + AudioManager.Remove( IVideoPlayback( singleton_VideoFFMpeg ) ); end. -- cgit v1.2.3 From 015dfecd8b6e4e1463509822ca4179ee88add976 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 25 Oct 2007 11:33:44 +0000 Subject: first effort to work towards jira#USDX-60 song directory enumeration is now unicode compliant on linux. still needs doing for windows, with wfindfile ( I think thats the right name ) this still relies on sdl_ttf and lots of other changes, but I had a few min and wanted to play with this :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@527 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 1528 ++++++++++++++++++++--------------------- Game/Code/Classes/USongs.pas | 1533 +++++++++++++++++++++--------------------- 2 files changed, 1541 insertions(+), 1520 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 9cd3bdc1..7e23b42f 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -1,764 +1,764 @@ -unit UFiles; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses SysUtils, - ULog, - UMusic, - USongs; - -//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs -function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header -function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header -procedure ClearSong(var Song: TSong); //Clears Song Header values - -//Methodes Loading and Saving Songfiles -procedure ResetSingTemp; -procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); -function LoadSong(Name: string): boolean; -function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; - - - -var -{* - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; -*} - - SongFile: TextFile; // all procedures in this unit operates on this file - FileLineNo: integer; //Line which is readed at Last, for error reporting - - // variables available for all procedures - Base: array[0..1] of integer; - Rel: array[0..1] of integer; - Mult: integer = 1; - MultBPM: integer = 4; - -implementation - -uses TextGL, - UIni, - UMain; - -//-------------------- -// Clears Song Header values -//-------------------- -procedure ClearSong(var Song: TSong); -begin - //Main Information - Song.Title := ''; - Song.Artist := ''; - - //Sortings: - Song.Genre := 'Unknown'; - Song.Edition := 'Unknown'; - Song.Language := 'Unknown'; //Language Patch - - //Required Information - Song.Mp3 := ''; - {$IFDEF FPC} - setlength( Song.BPM, 0 ); - {$ELSE} - Song.BPM := 0; - {$ENDIF} - - Song.GAP := 0; - Song.Start := 0; - Song.Finish := 0; - - //Additional Information - Song.Background := ''; - Song.Cover := ''; - Song.Video := ''; - Song.VideoGAP := 0; - Song.NotesGAP := 0; - Song.Resolution := 4; - Song.Creator := ''; -end; - -//-------------------- -// Reads Standard TXT Header -//-------------------- -function ReadTXTHeader(var Song: TSong): boolean; -var - Line, Identifier, Value: String; - Temp: word; - Done: byte; -begin - Result := true; - Done := 0; - - //Read first Line - ReadLn (SongFile, Line); - - if (Length(Line)<=0) then - begin - Log.LogError('File Starts with Empty Line: ' + Song.FileName); - Result := False; - Exit; - end; - - //Read Lines while Line starts with # - While (Length(Line) = 0) OR (Line[1] = '#') do - begin - //Increase Line Number - Inc (FileLineNo); - Temp := Pos(':', Line); - - //Line has a Seperator-> Headerline - if (Temp <> 0) then - begin - //Read Identifier and Value - Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks - Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); - - Log.LogError('Identifier: '+Identifier+' - '+ Value ); - - //Check the Identifier (If Value is given) - if (Length(Value) <> 0) then - begin - - //----------- - //Required Attributes - //----------- - - //Title - if (Identifier = 'TITLE') then - begin - Song.Title := Value; - - //Add Title Flag to Done - Done := Done or 1; - end - - //Artist - else if (Identifier = 'ARTIST') then - begin - Song.Artist := Value; - - //Add Artist Flag to Done - Done := Done or 2; - end - - //MP3 File //Test if Exists - else if (Identifier = 'MP3') AND (FileExists(Song.Path + Value)) then - begin - Song.Mp3 := Value; - - //Add Mp3 Flag to Done - Done := Done or 4; - end - - //Beats per Minute - else if (Identifier = 'BPM') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - SetLength(Song.BPM, 1); - Song.BPM[0].StartBeat := 0; - - Song.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; - - if Song.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end - - //--------- - //Additional Header Information - //--------- - - // Video Gap - else if (Identifier = 'GAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.GAP := StrtoFloatDef (Value, 0); - end - - //Cover Picture - else if (Identifier = 'COVER') then - begin - Song.Cover := Value; - end - - //Background Picture - else if (Identifier = 'BACKGROUND') then - begin - Song.Background := Value; - end - - // Video File - else if (Identifier = 'VIDEO') then - begin - if (FileExists(Song.Path + Value)) then - Song.Video := Value - else - Log.LogError('Can''t find Video File in Song: ' + Song.Path + Song.FileName); - end - - // Video Gap - else if (Identifier = 'VIDEOGAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.VideoGAP := StrtoFloatDef (Value, 0); - end - - //Genre Sorting - else if (Identifier = 'GENRE') then - begin - Song.Genre := Value; - end - - //Edition Sorting - else if (Identifier = 'EDITION') then - begin - Song.Edition := Value; - end - - //Creator Tag - else if (Identifier = 'CREATOR') then - begin - Song.Creator := Value; - end - - //Language Sorting - else if (Identifier = 'LANGUAGE') then - begin - Song.Language := Value; - end - - // Song Start - else if (Identifier = 'START') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.Start := StrtoFloatDef(Value, 0); - end - - // Song Ending - else if (Identifier = 'END') then - begin - TryStrtoInt(Value, Song.Finish); - end - - // Resolution - else if (Identifier = 'RESOLUTION') then - begin - TryStrtoInt(Value, Song.Resolution); - end - - // Notes Gap - else if (Identifier = 'NOTESGAP') then - begin - TryStrtoInt(Value, Song.NotesGAP); - end - - // Relative Notes - else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then - begin - Song.Relative := True; - end; - - end; - end; - - if not EOf(SongFile) then - ReadLn (SongFile, Line) - else - begin - Result := False; - Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + Song.FileName); - break; - end; - - {//End on first empty Line - if (Length(Line) = 0) then - break;} - end; - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := False; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + Song.FileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + Song.FileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + Song.FileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + Song.FileName) - else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + Song.FileName); - end; - -end; - -//-------------------- -// Analyse Song File and Read Header -//-------------------- -function AnalyseFile(var Song: TSong): boolean; -begin -Result := False; -{try } - //Reset LineNo - FileLineNo := 0; - - //Open File and set File Pointer to the beginning - AssignFile(SongFile, Song.Path + Song.FileName); - Reset(SongFile); - - //Clear old Song Header - ClearSong(Song); - - //Read Header - Result := ReadTxTHeader(Song); - - //And Close File - CloseFile(SongFile); -{except - CloseFile(SongFile); - - Result := False; - //Error Reporting - Log.LogError('An Error occured reading Line ' + inttostr(FileLineNo) + ' from SongHeader: ' + Song.FileName); -end;} -end; - -//-------------------- -// Resets the temporary Sentence Arrays for each Player and some other Variables -//-------------------- -procedure ResetSingTemp; -var - Pet: integer; -begin - SetLength(Czesci, Length(Player)); - SetLength(AktSong.BPM, 0); - for Pet := 0 to High(Player) do begin - SetLength(Czesci[Pet].Czesc, 1); - SetLength(Czesci[Pet].Czesc[0].Nuta, 0); - Czesci[Pet].Czesc[0].Lyric := ''; - Czesci[Pet].Czesc[0].LyricWidth := 0; - Player[pet].Score := 0; - Player[pet].IlNut := 0; - Player[pet].HighNut := -1; - end; - //Reset Path and Filename Values to Prevent Errors in Editor - AktSong.Path := ''; - AktSong.FileName := ''; -end; - -//-------------------- -// Parses Note Infos and save them to Array -//-------------------- -procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -var - Space: boolean; -begin - case Ini.Solmization of - 1: // european - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' si '; - end; - end; - 2: // japanese - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' so '; - 9..10: LyricS := ' la '; - 11: LyricS := ' shi '; - end; - end; - 3: // american - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' ti '; - end; - end; - end; // case - - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin - SetLength(Nuta, Length(Nuta) + 1); - IlNut := IlNut + 1; - HighNut := HighNut + 1; - Muzyka.IlNut := Muzyka.IlNut + 1; - - Nuta[HighNut].Start := StartP; - if IlNut = 1 then begin - StartNote := Nuta[HighNut].Start; - if Czesci[NrCzesci].Ilosc = 1 then - Start := -100; -// Start := Nuta[HighNut].Start; - end; - - Nuta[HighNut].Dlugosc := DurationP; - Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; - - // back to the normal system with normal, golden and now freestyle notes - case TypeP of - 'F': Nuta[HighNut].Wartosc := 0; - ':': Nuta[HighNut].Wartosc := 1; - '*': Nuta[HighNut].Wartosc := 2; - end; - - Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; - - Nuta[HighNut].Ton := NoteP; - if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; - Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; - - Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); - Lyric := Lyric + Nuta[HighNut].Tekst; - - if TypeP = 'F' then - Nuta[HighNut].FreeStyle := true; - - Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; - end; // with -end; - -//-------------------- -// Called when a new Sentence is found in the TXT File -//-------------------- -procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); -var -I: Integer; -begin - - // stara czesc //Alter Satz //Update Old Part - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); - - //Total Notes Patch - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; - for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do - begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - - - // nowa czesc //Neuer Satz //Update New Part - SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); - Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; - Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; - - if not AktSong.Relative then - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - - if AktSong.Relative then begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; - end; - - Base[NrCzesciP] := 100; // high number -end; - -//-------------------- -// Load a Song -//-------------------- -function LoadSong(Name: string): boolean; -var - TempC: char; - Tekst: string; - CP: integer; // Current Player (0 or 1) - Pet: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I: Integer; -begin - Result := false; - - if not FileExists(Name) then begin - Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci'); - exit; - end; - - try - MultBPM := 4; // 4 - mnoznik dla czasu nut - Mult := 1; // 4 - dokladnosc pomiaru nut - Base[0] := 100; // high number -// Base[1] := 100; // high number - Czesci[0].Wartosc := 0; -// Czesci[1].Wartosc := 0; // here was the error in 0.3.2 - AktSong.Relative := false; - - Rel[0] := 0; -// Rel[1] := 0; - CP := 0; - Both := false; - if Length(Player) = 2 then Both := true; - - FileMode := fmOpenRead; - AssignFile(SongFile, Name); - Reset(SongFile); - - //Clear old Song Header - ClearSong(AktSong); - - if (AktSong.Path = '') then - AktSong.Path := ExtractFilePath(Name); - - if (AktSong.FileName = '') then - AktSong.Filename := ExtractFileName(Name); - //Read Header - Result := ReadTxTHeader(AktSong); - if not Result then - begin - CloseFile(SongFile); - Log.LogError('Error Loading SongHeader, abort Song Loading'); - Exit; - end; - - Result := False; - - Reset(SongFile); - FileLineNo := 0; - //Search for Note Begining - repeat - ReadLn(SongFile, Tekst); - Inc(FileLineNo); - - if (EoF(SongFile)) then - begin //Song File Corrupted - No Notes - CloseFile(SongFile); - Log.LogError('Could not load txt File, no Notes found: ' + Name); - Result := False; - Exit; - end; - Read(SongFile, TempC); - until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); - - SetLength(Czesci, 2); - for Pet := 0 to High(Czesci) do begin - SetLength(Czesci[Pet].Czesc, 1); - Czesci[Pet].High := 0; - Czesci[Pet].Ilosc := 1; - Czesci[Pet].Akt := 0; - Czesci[Pet].Resolution := AktSong.Resolution; - Czesci[Pet].NotesGAP := AktSong.NotesGAP; - Czesci[Pet].Czesc[0].IlNut := 0; - Czesci[Pet].Czesc[0].HighNut := -1; - end; - -// TempC := ':'; -// TempC := Tekst[1]; // read from backup variable, don't use default ':' value - - while (TempC <> 'E') AND (not EOF(SongFile)) do begin - if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin - // wczytuje nute - Read(SongFile, Param1); - Read(SongFile, Param2); - Read(SongFile, Param3); - Read(SongFile, ParamS); - - // dodaje nute - if not Both then - // P1 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else begin - // P1 + P2 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - end; // if - if TempC = '-' then begin - // reads sentence - Read(SongFile, Param1); - if AktSong.Relative then Read(SongFile, Param2); // read one more data for relative system - - // new sentence - if not Both then - // P1 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) - else begin - // P1 + P2 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); - NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); - end; - - end; // if - - if TempC = 'B' then begin - SetLength(AktSong.BPM, Length(AktSong.BPM) + 1); - Read(SongFile, AktSong.BPM[High(AktSong.BPM)].StartBeat); - AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0]; - - Read(SongFile, Tekst); - AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst); - AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM; - end; - - - if not Both then begin - Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; - Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); - //Total Notes Patch - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; - for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do - begin - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end else begin - for Pet := 0 to High(Czesci) do begin - Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; - Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); - //Total Notes Patch - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; - for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do - begin - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end; - end; - - Read(SongFile, TempC); - Inc(FileLineNo); - end; // while} - - CloseFile(SongFile); - except - try - CloseFile(SongFile); - except - - end; - - Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(FileLineNo)); - exit; - end; - - Result := true; -end; - -//-------------------- -// Saves a Song -//-------------------- -function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; -var - C: integer; - N: integer; - S: string; - B: integer; - RelativeSubTime: integer; - NoteState: String; - -begin -// Relative := true; // override (idea - use shift+S to save with relative) - AssignFile(SongFile, Name); - Rewrite(SongFile); - - WriteLn(SongFile, '#TITLE:' + Song.Title + ''); - WriteLn(SongFile, '#ARTIST:' + Song.Artist); - - if Song.Creator <> '' then WriteLn(SongFile, '#CREATOR:' + Song.Creator); - if Song.Edition <> 'Unknown' then WriteLn(SongFile, '#EDITION:' + Song.Edition); - if Song.Genre <> 'Unknown' then WriteLn(SongFile, '#GENRE:' + Song.Genre); - if Song.Language <> 'Unknown' then WriteLn(SongFile, '#LANGUAGE:' + Song.Language); - - WriteLn(SongFile, '#MP3:' + Song.Mp3); - - if Song.Cover <> '' then WriteLn(SongFile, '#COVER:' + Song.Cover); - if Song.Background <> '' then WriteLn(SongFile, '#BACKGROUND:' + Song.Background); - if Song.Video <> '' then WriteLn(SongFile, '#VIDEO:' + Song.Video); - if Song.VideoGAP <> 0 then WriteLn(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); - if Song.Resolution <> 4 then WriteLn(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); - if Song.NotesGAP <> 0 then WriteLn(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); - if Song.Start <> 0 then WriteLn(SongFile, '#START:' + FloatToStr(Song.Start)); - if Song.Finish <> 0 then WriteLn(SongFile, '#END:' + IntToStr(Song.Finish)); - if Relative then WriteLn(SongFile, '#RELATIVE:yes'); - - WriteLn(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); - WriteLn(SongFile, '#GAP:' + FloatToStr(Song.GAP)); - - RelativeSubTime := 0; - for B := 1 to High(AktSong.BPM) do - WriteLn(SongFile, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4)); - - for C := 0 to Czesc.High do begin - for N := 0 to Czesc.Czesc[C].HighNut do begin - with Czesc.Czesc[C].Nuta[N] do begin - - - //Golden + Freestyle Note Patch - case Czesc.Czesc[C].Nuta[N].Wartosc of - 0: NoteState := 'F '; - 1: NoteState := ': '; - 2: NoteState := '* '; - end; // case - S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst; - - - WriteLn(SongFile, S); - end; // with - end; // N - - if C < Czesc.High then begin // don't write end of last sentence - if not Relative then - S := '- ' + IntToStr(Czesc.Czesc[C+1].Start) - else begin - S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) + - ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime); - RelativeSubTime := Czesc.Czesc[C+1].Start; - end; - WriteLn(SongFile, S); - end; - - end; // C - - - WriteLn(SongFile, 'E'); - CloseFile(SongFile); -end; - -end. +unit UFiles; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses SysUtils, + ULog, + UMusic, + USongs; + +//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs +function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header +function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header +procedure ClearSong(var Song: TSong); //Clears Song Header values + +//Methodes Loading and Saving Songfiles +procedure ResetSingTemp; +procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); +function LoadSong(Name: string): boolean; +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; + + + +var +{* + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; +*} + + SongFile: TextFile; // all procedures in this unit operates on this file + FileLineNo: integer; //Line which is readed at Last, for error reporting + + // variables available for all procedures + Base: array[0..1] of integer; + Rel: array[0..1] of integer; + Mult: integer = 1; + MultBPM: integer = 4; + +implementation + +uses TextGL, + UIni, + UMain; + +//-------------------- +// Clears Song Header values +//-------------------- +procedure ClearSong(var Song: TSong); +begin + //Main Information + Song.Title := ''; + Song.Artist := ''; + + //Sortings: + Song.Genre := 'Unknown'; + Song.Edition := 'Unknown'; + Song.Language := 'Unknown'; //Language Patch + + //Required Information + Song.Mp3 := ''; + {$IFDEF FPC} + setlength( Song.BPM, 0 ); + {$ELSE} + Song.BPM := 0; + {$ENDIF} + + Song.GAP := 0; + Song.Start := 0; + Song.Finish := 0; + + //Additional Information + Song.Background := ''; + Song.Cover := ''; + Song.Video := ''; + Song.VideoGAP := 0; + Song.NotesGAP := 0; + Song.Resolution := 4; + Song.Creator := ''; +end; + +//-------------------- +// Reads Standard TXT Header +//-------------------- +function ReadTXTHeader(var Song: TSong): boolean; +var + Line, Identifier, Value: String; + Temp: word; + Done: byte; +begin + Result := true; + Done := 0; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + Song.FileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # + While (Length(Line) = 0) OR (Line[1] = '#') do + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + Log.LogError('Identifier: '+Identifier+' - '+ Value ); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + //Title + if (Identifier = 'TITLE') then + begin + Song.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + Song.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND (FileExists(Song.Path + Value)) then + begin + Song.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + SetLength(Song.BPM, 1); + Song.BPM[0].StartBeat := 0; + + Song.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; + + if Song.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + // Video Gap + else if (Identifier = 'GAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.GAP := StrtoFloatDef (Value, 0); + end + + //Cover Picture + else if (Identifier = 'COVER') then + begin + Song.Cover := Value; + end + + //Background Picture + else if (Identifier = 'BACKGROUND') then + begin + Song.Background := Value; + end + + // Video File + else if (Identifier = 'VIDEO') then + begin + if (FileExists(Song.Path + Value)) then + Song.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + Song.Path + Song.FileName); + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.VideoGAP := StrtoFloatDef (Value, 0); + end + + //Genre Sorting + else if (Identifier = 'GENRE') then + begin + Song.Genre := Value; + end + + //Edition Sorting + else if (Identifier = 'EDITION') then + begin + Song.Edition := Value; + end + + //Creator Tag + else if (Identifier = 'CREATOR') then + begin + Song.Creator := Value; + end + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + begin + Song.Language := Value; + end + + // Song Start + else if (Identifier = 'START') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + Song.Start := StrtoFloatDef(Value, 0); + end + + // Song Ending + else if (Identifier = 'END') then + begin + TryStrtoInt(Value, Song.Finish); + end + + // Resolution + else if (Identifier = 'RESOLUTION') then + begin + TryStrtoInt(Value, Song.Resolution); + end + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + begin + TryStrtoInt(Value, Song.NotesGAP); + end + + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + begin + Song.Relative := True; + end; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + Song.FileName); + break; + end; + + {//End on first empty Line + if (Length(Line) = 0) then + break;} + end; + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + Song.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + Song.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + Song.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + Song.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + Song.FileName); + end; + +end; + +//-------------------- +// Analyse Song File and Read Header +//-------------------- +function AnalyseFile(var Song: TSong): boolean; +begin +Result := False; +{try } + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, Song.Path + Song.FileName); + Reset(SongFile); + + //Clear old Song Header + ClearSong(Song); + + //Read Header + Result := ReadTxTHeader(Song); + + //And Close File + CloseFile(SongFile); +{except + CloseFile(SongFile); + + Result := False; + //Error Reporting + Log.LogError('An Error occured reading Line ' + inttostr(FileLineNo) + ' from SongHeader: ' + Song.FileName); +end;} +end; + +//-------------------- +// Resets the temporary Sentence Arrays for each Player and some other Variables +//-------------------- +procedure ResetSingTemp; +var + Pet: integer; +begin + SetLength(Czesci, Length(Player)); + SetLength(AktSong.BPM, 0); + for Pet := 0 to High(Player) do begin + SetLength(Czesci[Pet].Czesc, 1); + SetLength(Czesci[Pet].Czesc[0].Nuta, 0); + Czesci[Pet].Czesc[0].Lyric := ''; + Czesci[Pet].Czesc[0].LyricWidth := 0; + Player[pet].Score := 0; + Player[pet].IlNut := 0; + Player[pet].HighNut := -1; + end; + //Reset Path and Filename Values to Prevent Errors in Editor + AktSong.Path := ''; + AktSong.FileName := ''; +end; + +//-------------------- +// Parses Note Infos and save them to Array +//-------------------- +procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +var + Space: boolean; +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin + SetLength(Nuta, Length(Nuta) + 1); + IlNut := IlNut + 1; + HighNut := HighNut + 1; + Muzyka.IlNut := Muzyka.IlNut + 1; + + Nuta[HighNut].Start := StartP; + if IlNut = 1 then begin + StartNote := Nuta[HighNut].Start; + if Czesci[NrCzesci].Ilosc = 1 then + Start := -100; +// Start := Nuta[HighNut].Start; + end; + + Nuta[HighNut].Dlugosc := DurationP; + Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Nuta[HighNut].Wartosc := 0; + ':': Nuta[HighNut].Wartosc := 1; + '*': Nuta[HighNut].Wartosc := 2; + end; + + Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; + + Nuta[HighNut].Ton := NoteP; + if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; + Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; + + Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); + Lyric := Lyric + Nuta[HighNut].Tekst; + + if TypeP = 'F' then + Nuta[HighNut].FreeStyle := true; + + Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; + end; // with +end; + +//-------------------- +// Called when a new Sentence is found in the TXT File +//-------------------- +procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); +var +I: Integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); + + //Total Notes Patch + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; + for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); + Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; + Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; + + if not AktSong.Relative then + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + + if AktSong.Relative then begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; + end; + + Base[NrCzesciP] := 100; // high number +end; + +//-------------------- +// Load a Song +//-------------------- +function LoadSong(Name: string): boolean; +var + TempC: char; + Tekst: string; + CP: integer; // Current Player (0 or 1) + Pet: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Name) then begin + Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci'); + exit; + end; + + try + MultBPM := 4; // 4 - mnoznik dla czasu nut + Mult := 1; // 4 - dokladnosc pomiaru nut + Base[0] := 100; // high number +// Base[1] := 100; // high number + Czesci[0].Wartosc := 0; +// Czesci[1].Wartosc := 0; // here was the error in 0.3.2 + AktSong.Relative := false; + + Rel[0] := 0; +// Rel[1] := 0; + CP := 0; + Both := false; + if Length(Player) = 2 then Both := true; + + FileMode := fmOpenRead; + AssignFile(SongFile, Name); + Reset(SongFile); + + //Clear old Song Header + ClearSong(AktSong); + + if (AktSong.Path = '') then + AktSong.Path := ExtractFilePath(Name); + + if (AktSong.FileName = '') then + AktSong.Filename := ExtractFileName(Name); + //Read Header + Result := ReadTxTHeader(AktSong); + if not Result then + begin + CloseFile(SongFile); + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Tekst); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + CloseFile(SongFile); + Log.LogError('Could not load txt File, no Notes found: ' + Name); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Czesci, 2); + for Pet := 0 to High(Czesci) do begin + SetLength(Czesci[Pet].Czesc, 1); + Czesci[Pet].High := 0; + Czesci[Pet].Ilosc := 1; + Czesci[Pet].Akt := 0; + Czesci[Pet].Resolution := AktSong.Resolution; + Czesci[Pet].NotesGAP := AktSong.NotesGAP; + Czesci[Pet].Czesc[0].IlNut := 0; + Czesci[Pet].Czesc[0].HighNut := -1; + end; + +// TempC := ':'; +// TempC := Tekst[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do begin + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // wczytuje nute + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + // dodaje nute + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; // if + if TempC = '-' then begin + // reads sentence + Read(SongFile, Param1); + if AktSong.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + + end; // if + + if TempC = 'B' then begin + SetLength(AktSong.BPM, Length(AktSong.BPM) + 1); + Read(SongFile, AktSong.BPM[High(AktSong.BPM)].StartBeat); + AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst); + AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then begin + Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; + Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); + //Total Notes Patch + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; + for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do + begin + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end else begin + for Pet := 0 to High(Czesci) do begin + Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; + Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); + //Total Notes Patch + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; + for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do + begin + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end; + end; + + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + +//-------------------- +// Saves a Song +//-------------------- +function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + B: integer; + RelativeSubTime: integer; + NoteState: String; + +begin +// Relative := true; // override (idea - use shift+S to save with relative) + AssignFile(SongFile, Name); + Rewrite(SongFile); + + WriteLn(SongFile, '#TITLE:' + Song.Title + ''); + WriteLn(SongFile, '#ARTIST:' + Song.Artist); + + if Song.Creator <> '' then WriteLn(SongFile, '#CREATOR:' + Song.Creator); + if Song.Edition <> 'Unknown' then WriteLn(SongFile, '#EDITION:' + Song.Edition); + if Song.Genre <> 'Unknown' then WriteLn(SongFile, '#GENRE:' + Song.Genre); + if Song.Language <> 'Unknown' then WriteLn(SongFile, '#LANGUAGE:' + Song.Language); + + WriteLn(SongFile, '#MP3:' + Song.Mp3); + + if Song.Cover <> '' then WriteLn(SongFile, '#COVER:' + Song.Cover); + if Song.Background <> '' then WriteLn(SongFile, '#BACKGROUND:' + Song.Background); + if Song.Video <> '' then WriteLn(SongFile, '#VIDEO:' + Song.Video); + if Song.VideoGAP <> 0 then WriteLn(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then WriteLn(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then WriteLn(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then WriteLn(SongFile, '#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then WriteLn(SongFile, '#END:' + IntToStr(Song.Finish)); + if Relative then WriteLn(SongFile, '#RELATIVE:yes'); + + WriteLn(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + WriteLn(SongFile, '#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(AktSong.BPM) do + WriteLn(SongFile, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4)); + + for C := 0 to Czesc.High do begin + for N := 0 to Czesc.Czesc[C].HighNut do begin + with Czesc.Czesc[C].Nuta[N] do begin + + + //Golden + Freestyle Note Patch + case Czesc.Czesc[C].Nuta[N].Wartosc of + 0: NoteState := 'F '; + 1: NoteState := ': '; + 2: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst; + + + WriteLn(SongFile, S); + end; // with + end; // N + + if C < Czesc.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start) + else begin + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime); + RelativeSubTime := Czesc.Czesc[C+1].Start; + end; + WriteLn(SongFile, S); + end; + + end; // C + + + WriteLn(SongFile, 'E'); + CloseFile(SongFile); +end; + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index e236abf0..b45e7c2a 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,756 +1,777 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - -uses SysUtils, ULog, UTexture, UCatCovers; - -type - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: string; - Score: integer; - Length: string; - end; - - TSong = record - Path: string; - Folder: string; // for sorting by folder - FileName: string; - - // sorting methods - Category: array of string; // I think I won't need this - Genre: string; - Edition: string; - Language: string; // 0.5.0: new - - Title: string; - Artist: string; - - Text: string; - Creator: string; - - Cover: string; - CoverTex: TTexture; - Mp3: string; - Background: string; - Video: string; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - - TSongs = class - private - BrowsePos: Cardinal; //Actual Pos in Song Array - public - Song: array of TSong; // array of songs - Selected: integer; // selected song index - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: string); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: string): string; - end; - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) - -implementation - -uses StrUtils, - UFiles, - UMain, - UIni; - - -procedure TSongs.LoadSongList; -begin - Log.LogStatus('Initializing', 'LoadSongList'); - - // clear - Setlength(Song, 50); - - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); -// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); -end; - -procedure TSongs.BrowseDir(Dir: string); -var - SR: TSearchRec; // for parsing Songs Directory - SLen: integer; -begin - if FindFirst(Dir + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Dir + Sr.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - if FindFirst(Dir + '*.txt', 0, SR) = 0 then - begin - repeat - //New Mod for better Memory Management - -// Log.LogStatus('Parsing file: ' + Dir + SR.Name, 'LoadSongList'); - - - SLen := BrowsePos; - {//Old - SLen := Length(Song); - SetLength(Song, SLen + 1);//} - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then Dec(BrowsePos) - else begin - // scanning complete, file is good - // if there is no cover then try to find it - if Song[SLen].Cover = '' then Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); -// if Song[SLen].Background = '' then begin -// Song[SLen].Background := FindSongFile(Dir, '*[BG].jpg'); -// end; // no needed here} - - // fix by adding path. no, don't fix it. -// if Song[SLen].Cover <> '' then -// Song[SLen].Cover := Song[SLen].Path + Song[SLen].Cover; - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNext(SR) <> 0; - end; // if FindFirst - FindClose(SR); -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: string): string; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := Low(Songs.Song) to High(Songs.Song) do begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := Songs.Song[S].Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := Songs.Song[S].Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := Songs.Song[S].Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Title[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin - // add a letter Category Button - Inc(Order); - Letter := UpCase(Songs.Song[S].Artist[1]); - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := Songs.Song[S].Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := Songs.Song[S]; - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + +uses SysUtils, + oldlinux, + ULog, + UTexture, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: string; + Score: integer; + Length: string; + end; + + TSong = record + Path: string; + Folder: string; // for sorting by folder + FileName: string; + + // sorting methods + Category: array of string; // I think I won't need this + Genre: string; + Edition: string; + Language: string; // 0.5.0: new + + Title: string; + Artist: string; + + Text: string; + Creator: string; + + Cover: string; + CoverTex: TTexture; + Mp3: string; + Background: string; + Video: string; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class + private + BrowsePos: Cardinal; //Actual Pos in Song Array + public + Song: array of TSong; // array of songs + Selected: integer; // selected song index + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: string): string; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +implementation + +uses StrUtils, + UFiles, + UMain, + UIni; + + +procedure TSongs.LoadSongList; +begin + Log.LogStatus('Initializing', 'LoadSongList'); + + // clear + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); +// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); +end; + +procedure TSongs.BrowseDir(Dir: widestring); +var + SR: TSearchRec; // for parsing Songs Directory + SLen: integer; + + TheDir : pdir; + ADirent :pDirent; + Entry : Longint; + info : stat; +begin + {$ifdef win32} + if FindFirst(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows + begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + BrowseDir(Dir + Sr.Name + PathDelim); + end + until FindNext(SR) <> 0; + end; // if + FindClose(SR); + {$else} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := ReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( name[0] <> '.') then + BrowseDir( Dir + name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + {$endif} + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + if FindFirst(Dir + '*.txt', 0, SR) = 0 then + begin + repeat + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNext(SR) <> 0; + end; // if FindFirst + FindClose(SR); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: string): string; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Title[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin + // add a letter Category Button + Inc(Order); + Letter := UpCase(Songs.Song[S].Artist[1]); + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +end. -- cgit v1.2.3 From 17d2f56fb988150dafcb6fab9dff45cc484e5b0a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 26 Oct 2007 07:04:58 +0000 Subject: did some major work towards ffmpeg audio playback. still not working 100% needs code to be re-compared to original C Source because I Suspect there are some translation errors. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@529 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 690 +++++++++++++++++++++++++----------- 1 file changed, 476 insertions(+), 214 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 959d904a..548fb343 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -1,5 +1,14 @@ unit UAudio_FFMpeg; +(******************************************************************************* + +This unit is primarily based upon - + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + + and tutorial03.c + +*******************************************************************************) + interface {$IFDEF FPC} @@ -16,37 +25,76 @@ uses Classes, {$IFNDEF FPC} Forms, {$ENDIF} + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + SDL, // Used for Audio output Interface ULog, UMusic; +type + TPacketQueue = record + first_pkt , + last_pkt : pAVPacketList; + nb_packets : integer; + size : integer; + mutex : pSDL_mutex; + cond : pSDL_cond; + end; + pPacketQueue = ^TPacketQueue; + + function packet_queue_put(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket): integer; + function packet_queue_get(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket; block : integer ): integer; + procedure packet_queue_init( var aPacketQueue : TPacketQueue ); + procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; + function audio_decode_frame(aCodecCtx : TAVCodecContext; audio_buf : PUInt8; buf_size: integer): integer; + +var + singleton_MusicFFMpeg : IAudioPlayback = nil; + + implementation uses {$IFDEF FPC} lclintf, {$ENDIF} - URecord, + libc, +// URecord, UIni, UMain, UThemes; +//var +// singleton_MusicFFMpeg : IAudioPlayback = nil; + + const RecordSystem = 1; + SDL_AUDIO_BUFFER_SIZE = 1024; + type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, mpPaused, mpOpen); + + const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); +var + audioq : TPacketQueue; + quit : integer = 0; + + type TAudio_ffMpeg = class( TInterfacedObject, IAudioPlayback ) private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need + + BassStart: hStream; + BassBack: hStream; BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) + BassChange: hStream; BassOption: hStream; BassClick: hStream; BassDrum: hStream; @@ -60,11 +108,12 @@ type Loop: boolean; fHWND: THandle; + function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; public - Bass: hStream; +// Bass: hStream; + constructor create(); function GetName: String; procedure InitializePlayback; - procedure InitializeRecord; procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); @@ -77,7 +126,7 @@ type procedure Close; function Finished: boolean; function Length: real; - function Position: real; + function getPosition: real; procedure PlayStart; procedure PlayBack; procedure PlaySwoosh; @@ -89,9 +138,9 @@ type procedure PlayClap; procedure PlayShuffle; procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +// procedure CaptureStart; +// procedure CaptureStop; +// procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); procedure StopCard(Card: byte); function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; @@ -103,141 +152,83 @@ type procedure PlayCustomSound(const Index: Cardinal ); end; -var - singleton_MusicFFMpeg : IAudioPlayback; - -function TAudio_ffMpeg.GetName: String; +constructor TAudio_ffMpeg.create(); begin - result := 'FFMpeg'; + writeln( 'UVideo_FFMpeg - av_register_all' ); + av_register_all; end; -procedure TAudio_ffMpeg.InitializePlayback; +function TAudio_ffMpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; var - Pet: integer; - S: integer; + i : integer; + st : pAVStream; begin - Log.BenchmarkStart(4); - Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; + // Find the first video stream + aFirstAudioStream := -1; + aFirstVideoStream := -1; - {$ifdef win32} - // TODO : JB_Linux ... is this needed ? :) - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - {$ENDIF} - - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then + i := 0; + while ( i < aFormatCtx.nb_streams ) do begin - {$IFNDEF FPC} - // TODO : JB_linux find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; + writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); + st := aFormatCtx.streams[i]; - Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND + (aFirstVideoStream < 0) THEN + begin + writeln( 'Found Video Stream' ); + aFirstVideoStream := i; + end; - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND + ( aFirstAudioStream < 0) THEN + begin + writeln( 'Found Audio Stream' ); + aFirstAudioStream := i; + end; - Log.LogStatus('Loading Sounds', 'Music Initialize'); + inc( i ); + end; // while - Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + result := (aFirstAudioStream > -1) OR + (aFirstVideoStream > -1) ; // Didn't find any streams stream +end; -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - Log.BenchmarkEnd(4); - Log.LogBenchmark('--> Loading Sounds', 4); +function TAudio_ffMpeg.GetName: String; +begin + result := 'FFMpeg'; end; -procedure TAudio_ffMpeg.InitializeRecord; +procedure TAudio_ffMpeg.InitializePlayback; var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); +// Pet: integer; + S: integer; +begin - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); + LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; +(* + LoadSoundFromFile(BassStart, SoundPath + 'Common start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; + LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); + LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); + LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); +*) +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - BASS_RecordFree; +// Log.BenchmarkEnd(4); +// Log.LogBenchmark('--> Loading Sounds', 4); - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if end; + procedure TAudio_ffMpeg.SetVolume(Volume: integer); begin //Old Sets Wave Volume @@ -246,9 +237,11 @@ begin // TODO : jb_linux replace with something other than bass +(* BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +*) end; procedure TAudio_ffMpeg.SetMusicVolume(Volume: Integer); @@ -263,7 +256,7 @@ begin //Set Volume // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); end; procedure TAudio_ffMpeg.SetLoop(Enabled: boolean); @@ -277,11 +270,11 @@ begin if FileExists(Name) then begin // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); +// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); Loaded := true; //Set Max Volume - SetMusicVolume (100); +// SetMusicVolume (100); end; Result := Loaded; @@ -289,7 +282,8 @@ end; procedure TAudio_ffMpeg.Rewind; begin - if Loaded then begin + if Loaded then + begin end; end; @@ -298,12 +292,13 @@ var bytes: integer; begin // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); +// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); +// BASS_ChannelSetPosition(Bass, bytes); end; procedure TAudio_ffMpeg.Play; begin +(* // TODO : jb_linux replace with something other than bass if Loaded then begin @@ -312,26 +307,27 @@ begin BASS_ChannelPlay(Bass, False); // for setting position before playing end; +*) end; procedure TAudio_ffMpeg.Pause; //Pause Mod begin +(* // TODO : jb_linux replace with something other than bass if Loaded then begin BASS_ChannelPause(Bass); // Pauses Song end; +*) end; procedure TAudio_ffMpeg.Stop; begin - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); +// Bass_ChannelStop(Bass); end; procedure TAudio_ffMpeg.Close; begin - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); +// Bass_StreamFree(Bass); end; function TAudio_ffMpeg.Length: real; @@ -339,183 +335,344 @@ var bytes: integer; begin Result := 60; - +(* // TODO : jb_linux replace with something other than bass bytes := BASS_ChannelGetLength(Bass); Result := BASS_ChannelBytes2Seconds(Bass, bytes); +*) end; -function TAudio_ffMpeg.Position: real; +function TAudio_ffMpeg.getPosition: real; var bytes: integer; begin Result := 0; +(* // TODO : jb_linux replace with something other than bass bytes := BASS_ChannelGetPosition(BASS); Result := BASS_ChannelBytes2Seconds(BASS, bytes); +*) end; function TAudio_ffMpeg.Finished: boolean; begin Result := false; +(* // TODO : jb_linux replace with something other than bass if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then begin Result := true; end; +*) end; procedure TAudio_ffMpeg.PlayStart; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); +// BASS_ChannelPlay(BassStart, True); end; procedure TAudio_ffMpeg.PlayBack; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then +// BASS_ChannelPlay(BassBack, True);// then end; procedure TAudio_ffMpeg.PlaySwoosh; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); +// BASS_ChannelPlay(BassSwoosh, True); + + end; procedure TAudio_ffMpeg.PlayChange; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); +// BASS_ChannelPlay(BassChange, True); end; procedure TAudio_ffMpeg.PlayOption; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); +// BASS_ChannelPlay(BassOption, True); end; procedure TAudio_ffMpeg.PlayClick; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); +// BASS_ChannelPlay(BassClick, True); end; procedure TAudio_ffMpeg.PlayDrum; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); +// BASS_ChannelPlay(BassDrum, True); end; procedure TAudio_ffMpeg.PlayHihat; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); +// BASS_ChannelPlay(BassHihat, True); end; procedure TAudio_ffMpeg.PlayClap; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); +// BASS_ChannelPlay(BassClap, True); end; procedure TAudio_ffMpeg.PlayShuffle; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); +// BASS_ChannelPlay(BassShuffle, True); end; procedure TAudio_ffMpeg.StopShuffle; begin // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); +// BASS_ChannelStop(BassShuffle); end; -procedure TAudio_ffMpeg.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; +procedure TAudio_ffMpeg.StopCard(Card: byte); +begin + // TODO : jb_linux replace with something other than bass +// BASS_RecordSetDevice(Card); +// BASS_RecordFree; end; -procedure TAudio_ffMpeg.CaptureStop; +function audio_decode_frame(aCodecCtx : TAVCodecContext; audio_buf : PUInt8; buf_size: integer): integer; var - SC: integer; - P1: integer; - P2: integer; + pkt : TAVPacket; + audio_pkt_data : pchar;//PUInt8 = nil; + audio_pkt_size : integer; + len1 , + data_size : integer; begin +// result := 1; +// exit; + + while true do + begin + + while ( audio_pkt_size > 0 ) do + begin + writeln( 'got audio packet' ); + data_size := buf_size; + +// len1 := avcodec_decode_audio2(aCodecCtx, (int16_t )audio_buf, &data_size, audio_pkt_data, audio_pkt_size); + len1 := avcodec_decode_audio(@aCodecCtx, PWord( audio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. + +// writeln('avcodec_decode_audio'); + + if(len1 < 0) then + begin + //* if error, skip frame */ + audio_pkt_size := 0; + break; + end; + + audio_pkt_data := audio_pkt_data + len1; + audio_pkt_size := audio_pkt_size + len1; + + if (data_size <= 0) then + begin + //* No data yet, get more frames */ + continue; + end; + + //* We have data, return it and come back for more later */ + result := data_size; + exit; + end; + + if ( pkt.data <> nil ) then + av_free_packet( pkt ); + + if ( quit <> 0 ) then + begin + result := -1; + exit; + end; + + if (packet_queue_get(audioq, pkt, 1) < 0) then + begin + result := -1; + exit; + end; - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; + audio_pkt_data := pchar( pkt.data ); + audio_pkt_size := pkt.size; + writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + end; end; -//procedure TAudio_ffMpeg.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TAudio_ffMpeg.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); +procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); var - Error: integer; - ErrorMsg: string; + audio_buf_index : cardinal; // static unsigned int audio_buf_index = 0; + audio_buf_size : cardinal; // static unsigned int audio_buf_size = 0; + audio_size , + len1 : integer; + aCodecCtx : TAVCodecContext; + audio_buf : pUInt8 = nil; begin - if not BASS_RecordInit(RecordI) then - begin - Error := BASS_ErrorGetCode; + aCodecCtx := pAVCodecContext(userdata)^; + audio_buf := UInt8( (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2); // todo : JB + audio_size := -1; - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; +// writeln('----------- audio callback' ); - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); + while (len > 0) do + begin + if(audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more */ + audio_size := audio_decode_frame(aCodecCtx, audio_buf, sizeof(audio_buf)); + + if(audio_size < 0) then + begin + // If error, output silence */ + audio_buf_size := 1024; // arbitrary? + memset(audio_buf, 0, audio_buf_size); // todo : jb memset + end + else + begin + audio_buf_size := audio_size; + end; +// audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; -end; + if (len1 > len) then + len1 := len; + + memcpy(stream, PUInt8( audio_buf ) + audio_buf_index , len1); -procedure TAudio_ffMpeg.StopCard(Card: byte); -begin - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; + len := len - len1; + stream := stream + len1; + audio_buf_index := audio_buf_index + len1; + end; end; function TAudio_ffMpeg.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; var L: Integer; -begin + pFormatCtx: PAVFormatContext; + lVidStreamID , + lAudStreamID : Integer; + aCodecCtx : pAVCodecContext; + wanted_spec , + spec : TSDL_AudioSpec; + lAudioStream : pAVStream; + aCodec : pAVCodec; + i : integer; + packet : TAVPacket; + event : TSDL_Event; +begin + result := false; + if FileExists(Name) then begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + + // Open video file + if (av_open_input_file(pFormatCtx, pchar(Name), nil, 0, nil) > 0) then + exit; + + // Retrieve stream information + if (av_find_stream_info(pFormatCtx)<0) then + exit; + + dump_format(pFormatCtx, 0, pchar(Name), 0); + + if not find_stream_ids( pFormatCtx, lVidStreamID, lAudStreamID ) then + exit; + + writeln( 'done searching for stream ids' ); + + if lAudStreamID > -1 then + begin + writeln( 'Audio Stream ID is : '+ inttostr( lAudStreamID ) ); + + lAudioStream := pFormatCtx.streams[lAudStreamID]; + aCodecCtx := lAudioStream.codec; + + // Set audio settings from codec info + wanted_spec.freq := aCodecCtx.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := aCodecCtx.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := audio_callback; + wanted_spec.userdata := aCodecCtx; + end; + + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + writeln('SDL_OpenAudio: '+SDL_GetError()); + exit + end; + + writeln( 'SDL opened audio device' ); + + aCodec := avcodec_find_decoder(aCodecCtx.codec_id); + if (aCodec = nil) then + begin + writeln('Unsupported codec!'); + exit; + end; + + avcodec_open(aCodecCtx, aCodec); + + writeln( 'Opened the codec' ); + + packet_queue_init( audioq ); + SDL_PauseAudio(0); + + writeln( 'SDL_PauseAudio' ); + + i := 0; + while (av_read_frame(pFormatCtx, packet)>=0) do + begin + writeln( 'ffmpeg - av_read_frame' ); + + if (packet.stream_index = lAudStreamID ) then + begin + packet_queue_put(audioq, packet); + end + else + begin + av_free_packet(packet); + end; + + + // Free the packet that was allocated by av_read_frame + SDL_PollEvent(@event); + +(* + if event.type_ = SDL_QUIT the + begin + quit := 1; + SDL_Quit(); + end + else + break; +*) + + end; + + // Close the codec + avcodec_close(aCodecCtx); + + // Close the video file + av_close_input_file(pFormatCtx); + +(* try // TODO : jb_linux replace with something other than bass hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); @@ -528,21 +685,124 @@ begin except Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); end; +*) + end else begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + writeln('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; + +end; + +procedure packet_queue_init(var aPacketQueue : TPacketQueue ); +begin + memset(@aPacketQueue, 0, sizeof(TPacketQueue)); + + aPacketQueue.mutex := SDL_CreateMutex(); + aPacketQueue.cond := SDL_CreateCond(); +end; + +function packet_queue_put(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket): integer; +var + pkt1 : pAVPacketList; +begin + result := -1; + + writeln( 'TAudio_ffMpeg.packet_queue_put' ); + + if av_dup_packet(@AVPacket) < 0 then exit; + + pkt1 := av_malloc(sizeof(TAVPacketList)); + if (pkt1 = nil) then + exit; + + pkt1.pkt := AVPacket; + pkt1.next := nil; + + + SDL_LockMutex( aPacketQueue.mutex ); + try + + if (aPacketQueue.last_pkt = nil) then + aPacketQueue.first_pkt := pkt1 + else + aPacketQueue.last_pkt.next := pkt1; + + aPacketQueue.last_pkt := pkt1; + inc( aPacketQueue.nb_packets ); + + aPacketQueue.size := aPacketQueue.size + pkt1.pkt.size; + SDL_CondSignal(aPacketQueue.cond); + + finally + SDL_UnlockMutex( aPacketQueue.mutex ); end; + + result := 0; end; +function packet_queue_get(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket; block : integer ): integer; +var + pkt1 : pAVPacketList; +begin + result := -1; +// writeln( 'packet_queue_get' ); + + SDL_LockMutex(aPacketQueue.mutex); + try + while true do + begin + + if (quit <> 0) then + exit; + + pkt1 := aPacketQueue.first_pkt; + + if ( pkt1 <> nil ) then + begin + aPacketQueue.first_pkt := pkt1.next; + + if (aPacketQueue.first_pkt = nil ) then + aPacketQueue.last_pkt := nil; + + dec(aPacketQueue.nb_packets); + + aPacketQueue.size := aPacketQueue.size - pkt1.pkt.size; + + AVPacket := pkt1.pkt; + + av_free(pkt1); + + result := 1; + break; + end + else + if (block = 0) then + begin + result := 0; + break; + end + else + begin + SDL_CondWait(aPacketQueue.cond, aPacketQueue.mutex); + end; + end; + finally + SDL_UnlockMutex(aPacketQueue.mutex); + end; +end; + + //Equalizer function TAudio_ffMpeg.GetFFTData: TFFTData; var Data: TFFTData; begin //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); end; function TAudio_ffMpeg.LoadCustomSound(const Filename: String): Cardinal; @@ -551,6 +811,7 @@ var I: Integer; F: String; begin +(* //Search for Sound in already loaded Sounds F := UpperCase(SoundPath + FileName); For I := 0 to High(CustomSounds) do @@ -566,12 +827,13 @@ begin Result := High(CustomSounds) else Result := 0; +*) end; procedure TAudio_ffMpeg.PlayCustomSound(const Index: Cardinal ); begin - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); +// if Index <= High(CustomSounds) then +// BASS_ChannelPlay(CustomSounds[Index].Handle, True); end; @@ -625,8 +887,8 @@ initialization writeln( 'UAudio_Bass - Register Playback' ); AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); -finalization - AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); - +finalization + AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); + end. -- cgit v1.2.3 From 64f2c9b369185575d397dccbbcacc7f818874952 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 27 Oct 2007 01:37:00 +0000 Subject: fixed my oops, and have also fixed bamboo build to show this error.. doh git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@532 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index b45e7c2a..99474961 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -8,7 +8,9 @@ interface uses SysUtils, + {$ifndef win32} oldlinux, + {$endif} ULog, UTexture, UCatCovers; @@ -134,10 +136,12 @@ var SR: TSearchRec; // for parsing Songs Directory SLen: integer; - TheDir : pdir; - ADirent :pDirent; - Entry : Longint; + {$ifndef win32} + TheDir : pdir; + ADirent :pDirent; + Entry : Longint; info : stat; + {$endif} begin {$ifdef win32} if FindFirst(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows -- cgit v1.2.3 From 8cca9e3e6f591c35d35d132a9d3f93ffc7cdfee8 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 27 Oct 2007 06:31:04 +0000 Subject: made some major progress with ffmpeg audio playback !!! YAY !!! still a little choppy, so I suspect incorrect buffer sizes or something like that. also made some mods to support Unicode song file iteration on windows, this is no worse than what we had before, but is not complete.. oh this code only supports win 2000 and up .. no Win 98... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@533 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 153 ++++++++++++++++++++++++------------ Game/Code/Classes/UCommon.pas | 88 +++++++++++++++++++++ Game/Code/Classes/UFiles.pas | 20 +++-- Game/Code/Classes/USongs.pas | 65 +++++++-------- Game/Code/Classes/UVideo.pas | 85 ++++++++++++++------ 5 files changed, 297 insertions(+), 114 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 548fb343..35822a3b 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -7,6 +7,8 @@ This unit is primarily based upon - and tutorial03.c + http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + *******************************************************************************) interface @@ -25,10 +27,10 @@ uses Classes, {$IFNDEF FPC} Forms, {$ENDIF} + SDL, // Used for Audio output Interface avcodec, // FFMpeg Audio file decoding avformat, avutil, - SDL, // Used for Audio output Interface ULog, UMusic; @@ -47,19 +49,28 @@ type function packet_queue_get(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket; block : integer ): integer; procedure packet_queue_init( var aPacketQueue : TPacketQueue ); procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; - function audio_decode_frame(aCodecCtx : TAVCodecContext; audio_buf : PUInt8; buf_size: integer): integer; + function audio_decode_frame(aCodecCtx : TAVCodecContext; aAudio_buf : PUInt8; buf_size: integer): integer; var singleton_MusicFFMpeg : IAudioPlayback = nil; +var + audioq : TPacketQueue; + quit : integer = 0; +// faudio_buf : array[ 0 .. 0 ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} +// audio_buf : array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} + +type + Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; + PAudioBuff = ^Taudiobuff; implementation uses {$IFDEF FPC} lclintf, - {$ENDIF} libc, + {$ENDIF} // URecord, UIni, UMain, @@ -82,9 +93,6 @@ type const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); -var - audioq : TPacketQueue; - quit : integer = 0; type @@ -154,7 +162,7 @@ end; constructor TAudio_ffMpeg.create(); begin - writeln( 'UVideo_FFMpeg - av_register_all' ); +// writeln( 'UVideo_FFMpeg - av_register_all' ); av_register_all; end; @@ -170,20 +178,20 @@ begin i := 0; while ( i < aFormatCtx.nb_streams ) do begin - writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); +// writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); st := aFormatCtx.streams[i]; if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND (aFirstVideoStream < 0) THEN begin - writeln( 'Found Video Stream' ); +// writeln( 'Found Video Stream' ); aFirstVideoStream := i; end; if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND ( aFirstAudioStream < 0) THEN begin - writeln( 'Found Audio Stream' ); +// writeln( 'Found Audio Stream' ); aFirstAudioStream := i; end; @@ -206,8 +214,8 @@ var S: integer; begin - LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); - +// LoadSoundFromFile(BassStart, SoundPath + 'Green Day - American Idiot.mp3'); + (* LoadSoundFromFile(BassStart, SoundPath + 'Common start.mp3'); LoadSoundFromFile(BassBack, SoundPath + 'Common back.mp3'); @@ -438,12 +446,13 @@ end; procedure TAudio_ffMpeg.StopCard(Card: byte); begin + // TODO : jb_linux replace with something other than bass // BASS_RecordSetDevice(Card); // BASS_RecordFree; end; -function audio_decode_frame(aCodecCtx : TAVCodecContext; audio_buf : PUInt8; buf_size: integer): integer; +function audio_decode_frame(aCodecCtx : TAVCodecContext; aAudio_buf : PUInt8; buf_size: integer): integer; var pkt : TAVPacket; audio_pkt_data : pchar;//PUInt8 = nil; @@ -451,26 +460,44 @@ var len1 , data_size : integer; begin -// result := 1; -// exit; + {$ifdef win32} + FillChar(pkt, sizeof(pkt), #0); + {$else} + memset(@pkt, 0, sizeof(pkt)); // todo : jb memset + {$endif} + + audio_pkt_data := nil; + audio_pkt_size := 0; while true do begin while ( audio_pkt_size > 0 ) do begin - writeln( 'got audio packet' ); +// writeln( 'got audio packet' ); data_size := buf_size; - -// len1 := avcodec_decode_audio2(aCodecCtx, (int16_t )audio_buf, &data_size, audio_pkt_data, audio_pkt_size); - len1 := avcodec_decode_audio(@aCodecCtx, PWord( audio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. + + len1 := -1; + + if aAudio_buf <> nil then + begin +// writeln( 'pre avcodec_decode_audio' ); + {$ifdef fpc} + len1 := avcodec_decode_audio(@aCodecCtx, PWord( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. + {$else} + len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. + {$endif} +// writeln( 'post avcodec_decode_audio' ); + + end; // writeln('avcodec_decode_audio'); if(len1 < 0) then begin //* if error, skip frame */ - audio_pkt_size := 0; +// writeln( 'Skip audio frame' ); + audio_pkt_size := 0; break; end; @@ -506,7 +533,7 @@ begin audio_pkt_data := pchar( pkt.data ); audio_pkt_size := pkt.size; - writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); +// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); end; end; @@ -517,52 +544,69 @@ var audio_size , len1 : integer; aCodecCtx : TAVCodecContext; - audio_buf : pUInt8 = nil; + + lSrc : pointer; + + // this is used to emulate ...... static uint8_t audio_buf[(AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) / 2]; + lAudio_buf_data : Taudiobuff; // This created the memory we need + laudio_buf : PAudioBuff; // this makes it easy to work with.. since its the pointer to that memeory everywhere begin - aCodecCtx := pAVCodecContext(userdata)^; - audio_buf := UInt8( (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2); // todo : JB - audio_size := -1; + laudio_buf := @lAudio_buf_data ; -// writeln('----------- audio callback' ); + aCodecCtx := pAVCodecContext(userdata)^; + audio_size := -1; + audio_buf_index := 0; + audio_buf_size := 0; while (len > 0) do begin if(audio_buf_index >= audio_buf_size) then begin // We have already sent all our data; get more */ - audio_size := audio_decode_frame(aCodecCtx, audio_buf, sizeof(audio_buf)); + audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(laudio_buf)); if(audio_size < 0) then begin // If error, output silence */ audio_buf_size := 1024; // arbitrary? - memset(audio_buf, 0, audio_buf_size); // todo : jb memset + + {$ifdef win32} + FillChar(laudio_buf, audio_buf_size, #0); + {$else} + memset(laudio_buf, 0, audio_buf_size); // todo : jb memset + {$endif} end else begin audio_buf_size := audio_size; end; -// audio_buf_index := 0; // Todo : jb - SegFault ? + audio_buf_index := 0; // Todo : jb - SegFault ? end; len1 := audio_buf_size - audio_buf_index; if (len1 > len) then len1 := len; - - memcpy(stream, PUInt8( audio_buf ) + audio_buf_index , len1); - len := len - len1; - stream := stream + len1; + + {$ifdef win32} + lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); + CopyMemory(stream, lSrc , len1); + {$else} + memcpy(stream, PUInt8( laudio_buf ) + audio_buf_index , len1); + {$endif} + + len := len - len1; + stream^ := stream^ + len1; audio_buf_index := audio_buf_index + len1; end; end; function TAudio_ffMpeg.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; var - L: Integer; - pFormatCtx: PAVFormatContext; + L : Integer; + pFormatCtx : PAVFormatContext; lVidStreamID , lAudStreamID : Integer; aCodecCtx : pAVCodecContext; @@ -578,7 +622,7 @@ begin if FileExists(Name) then begin - writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); +// writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); // Open video file if (av_open_input_file(pFormatCtx, pchar(Name), nil, 0, nil) > 0) then @@ -593,11 +637,11 @@ begin if not find_stream_ids( pFormatCtx, lVidStreamID, lAudStreamID ) then exit; - writeln( 'done searching for stream ids' ); +// writeln( 'done searching for stream ids' ); if lAudStreamID > -1 then begin - writeln( 'Audio Stream ID is : '+ inttostr( lAudStreamID ) ); +// writeln( 'Audio Stream ID is : '+ inttostr( lAudStreamID ) ); lAudioStream := pFormatCtx.streams[lAudStreamID]; aCodecCtx := lAudioStream.codec; @@ -617,9 +661,9 @@ begin writeln('SDL_OpenAudio: '+SDL_GetError()); exit end; - - writeln( 'SDL opened audio device' ); - + +// writeln( 'SDL opened audio device' ); + aCodec := avcodec_find_decoder(aCodecCtx.codec_id); if (aCodec = nil) then begin @@ -629,27 +673,28 @@ begin avcodec_open(aCodecCtx, aCodec); - writeln( 'Opened the codec' ); +// writeln( 'Opened the codec' ); packet_queue_init( audioq ); SDL_PauseAudio(0); - writeln( 'SDL_PauseAudio' ); +// writeln( 'SDL_PauseAudio' ); i := 0; - while (av_read_frame(pFormatCtx, packet)>=0) do + while (av_read_frame(pFormatCtx, packet) >= 0) do begin - writeln( 'ffmpeg - av_read_frame' ); +// writeln( 'ffmpeg - av_read_frame' ); if (packet.stream_index = lAudStreamID ) then begin +// writeln( 'packet_queue_put' ); packet_queue_put(audioq, packet); end else begin av_free_packet(packet); end; - + // Free the packet that was allocated by av_read_frame SDL_PollEvent(@event); @@ -665,12 +710,14 @@ begin *) end; - + +// halt(0); + // Close the codec - avcodec_close(aCodecCtx); +// avcodec_close(aCodecCtx); // Close the video file - av_close_input_file(pFormatCtx); +// av_close_input_file(pFormatCtx); (* try @@ -698,7 +745,11 @@ end; procedure packet_queue_init(var aPacketQueue : TPacketQueue ); begin - memset(@aPacketQueue, 0, sizeof(TPacketQueue)); + {$ifdef win32} + FillChar(aPacketQueue, sizeof(TPacketQueue), #0); + {$else} + memset(@aPacketQueue, 0, sizeof(TPacketQueue)); + {$endif} aPacketQueue.mutex := SDL_CreateMutex(); aPacketQueue.cond := SDL_CreateCond(); @@ -710,7 +761,7 @@ var begin result := -1; - writeln( 'TAudio_ffMpeg.packet_queue_put' ); +// writeln( 'TAudio_ffMpeg.packet_queue_put' ); if av_dup_packet(@AVPacket) < 0 then exit; diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index af9ae82d..44ec6bb3 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -58,6 +58,26 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} +{$IFDEF Win32} + +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; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; +{$endif} + implementation function StringReplaceW(text : WideString; search, rep: WideChar):WideString; @@ -190,7 +210,75 @@ begin end; {$ENDIF} + + + {$ENDIF} +{$ifdef win32} +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; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + 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 + if FindNextFileW(F.FindHandle, F.FindData) then + 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 + if not FindNextFileW(FindHandle, FindData) then + 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; +{$endif} + + + + end. diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 7e23b42f..717d20e2 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -333,16 +333,22 @@ Result := False; //Open File and set File Pointer to the beginning AssignFile(SongFile, Song.Path + Song.FileName); - Reset(SongFile); +// if assinged( SongFile ) then + begin + try + Reset(SongFile); - //Clear old Song Header - ClearSong(Song); + //Clear old Song Header + ClearSong(Song); - //Read Header - Result := ReadTxTHeader(Song); + //Read Header + Result := ReadTxTHeader(Song); - //And Close File - CloseFile(SongFile); + //And Close File + finally + CloseFile(SongFile); + end; + end; {except CloseFile(SongFile); diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 99474961..e3c54ac4 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -13,6 +13,7 @@ uses SysUtils, {$endif} ULog, UTexture, + UCommon, UCatCovers; type @@ -23,33 +24,33 @@ type end; TScore = record - Name: string; + Name: widestring; Score: integer; Length: string; end; TSong = record - Path: string; - Folder: string; // for sorting by folder - FileName: string; + Path: widestring; + Folder: widestring; // for sorting by folder + FileName: widestring; // sorting methods - Category: array of string; // I think I won't need this - Genre: string; - Edition: string; - Language: string; // 0.5.0: new + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new - Title: string; - Artist: string; + Title: widestring; + Artist: widestring; - Text: string; - Creator: string; + Text: widestring; + Creator: widestring; - Cover: string; + Cover: widestring; CoverTex: TTexture; - Mp3: string; - Background: string; - Video: string; + Mp3: widestring; + Background: widestring; + Video: widestring; VideoGAP: real; VideoLoaded: boolean; // 0.5.0: true if the video has been loaded NotesGAP: integer; @@ -79,7 +80,7 @@ type procedure LoadSongList; // load all songs procedure BrowseDir(Dir: widestring); // should return number of songs in the future procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: string): string; + function FindSongFile(Dir, Mask: widestring): widestring; end; TCatSongs = class @@ -133,7 +134,7 @@ end; procedure TSongs.BrowseDir(Dir: widestring); var - SR: TSearchRec; // for parsing Songs Directory + SR: TSearchRecW; // for parsing Songs Directory SLen: integer; {$ifndef win32} @@ -144,16 +145,16 @@ var {$endif} begin {$ifdef win32} - if FindFirst(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows + if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then begin BrowseDir(Dir + Sr.Name + PathDelim); end - until FindNext(SR) <> 0; + until FindNextw(SR) <> 0; end; // if - FindClose(SR); + FindClosew(SR); {$else} // Itterate the Songs Directory... ( With unicode capable functions for linux ) TheDir := opendir( Dir ); // JB_Unicode - linux @@ -178,7 +179,7 @@ begin // Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - if FindFirst(Dir + '*.txt', 0, SR) = 0 then + if FindFirstW(Dir + '*.txt', 0, SR) = 0 then begin repeat SLen := BrowsePos; @@ -204,9 +205,9 @@ begin SetLength(Song, Length(Song) + 50); end; - until FindNext(SR) <> 0; + until FindNextW(SR) <> 0; end; // if FindFirst - FindClose(SR); + FindCloseW(SR); end; procedure TSongs.Sort(Order: integer); @@ -309,7 +310,7 @@ begin end; // case end; -function TSongs.FindSongFile(Dir, Mask: string): string; +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; var SR: TSearchRec; // for parsing song directory begin @@ -463,10 +464,12 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sTitle) and (Length(Songs.Song[S].Title)>=1) and (Letter <> UpCase(Songs.Song[S].Title[1])) then begin + else if (Ini.Sorting = sTitle) and + (Length(Songs.Song[S].Title)>=1) and + (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin // add a letter Category Button Inc(Order); - Letter := UpCase(Songs.Song[S].Title[1]); + Letter := Uppercase(Songs.Song[S].Title)[1]; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -491,10 +494,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpCase(Songs.Song[S].Artist[1])) then begin + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin // add a letter Category Button Inc(Order); - Letter := UpCase(Songs.Song[S].Artist[1]); + Letter := UpperCase(Songs.Song[S].Artist)[1]; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -545,7 +548,7 @@ case Ini.Sorting of end else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Title[1]); + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); @@ -575,7 +578,7 @@ case Ini.Sorting of end else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpCase(Songs.Song[S].Artist[1]); + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 4c27867d..154cd04c 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -10,9 +10,11 @@ unit UVideo; # # ############################################################################## } -{$define DebugDisplay} // uncomment if u want to see the debug stuff +//{$define DebugDisplay} // uncomment if u want to see the debug stuff //{$define DebugFrames} //{$define Info} + +//{$define FFMpegAudio} {} @@ -45,6 +47,9 @@ uses SDL, dialogs, {$endif} {$ENDIF} + {$ifdef FFMpegAudio} + UAudio_FFMpeg, + {$endif} UIni, UMusic; @@ -108,7 +113,9 @@ type end; - + const + SDL_AUDIO_BUFFER_SIZE = 1024; + {$ifdef DebugDisplay} //{$ifNdef win32} @@ -262,19 +269,23 @@ begin FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) -// while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, AVPacket)>=0) do // JB-ffmpeg + while ( FrameFinished = 0 ) and + ( av_read_frame(VideoFormatContext, AVPacket) >= 0 ) do // JB-ffmpeg begin // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then -// errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished , AVPacket.data, AVPacket.size); + begin errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg - - - // release internal packet structure created by av_read_frame -// av_free_packet(PAVPacket(@AVPacket)); + {$ifdef FFMpegAudio} + end + else + if (AVPacket.stream_index = AudioStreamIndex ) then + begin + UAudio_FFMpeg.packet_queue_put(UAudio_FFMpeg.audioq, AVPacket); + {$endif} + end; try if AVPacket.data <> nil then @@ -427,6 +438,10 @@ var errnum, i, x,y: Integer; lStreamsCount : Integer; + wanted_spec , + spec : TSDL_AudioSpec; + aCodec : pAVCodec; + begin fVideoOpened := False; fVideoPaused := False; @@ -471,27 +486,47 @@ begin end; aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; + {$ifdef FFMpegAudio} + // This is the audio ffmpeg audio support Jay is working on. if aCodecCtx <> nil then begin + wanted_spec.freq := aCodecCtx.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := aCodecCtx.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := UAudio_FFMpeg.audio_callback; + wanted_spec.userdata := aCodecCtx; -// WantedAudioCodecContext.freq := aCodecCtx^.sample_rate; -// WantedAudioCodecContext.format := AUDIO_S16SYS; -// WantedAudioCodecContext.channels := aCodecCtx^.channels; -(* WantedAudioCodecContext.silence := 0; - WantedAudioCodecContext.samples := 1024;//SDL_AUDIO_BUFFER_SIZE; -// WantedAudioCodecContext.callback := audio_callback; - WantedAudioCodecContext.userdata := aCodecCtx; -*) + + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + writeln('SDL_OpenAudio: '+SDL_GetError()); + exit; + end; + + writeln( 'SDL opened audio device' ); + + aCodec := avcodec_find_decoder(aCodecCtx.codec_id); + if (aCodec = nil) then + begin + writeln('Unsupported codec!'); + exit; + end; + + avcodec_open(aCodecCtx, aCodec); + + writeln( 'Opened the codec' ); + + packet_queue_init( audioq ); + SDL_PauseAudio(0); + + writeln( 'SDL_PauseAudio' ); + end; -(* - if(SDL_OpenAudio(WantedAudioCodecContext, AudioCodecContext) < 0) then - begin - writeln( 'Could not do SDL_OpenAudio' ); - exit; - end; -*) - + {$endif} + if(VideoStreamIndex >= 0) then begin VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; -- cgit v1.2.3 From e270d3193a2a5b958e6416ce340246e790f7bd86 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 27 Oct 2007 09:10:29 +0000 Subject: Finished pluginloader, plugininterface Some fixes and error management (needs improvement) in Core and Service/Hook classes. "Clean Plugin Unloading on Error" finished Some debuging messages on startup. to Fix this remove old Plugins from Pluginfolder git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@535 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 36 +- Game/Code/Classes/UCoreModule.pas | 13 +- Game/Code/Classes/UHooks.pas | 117 +++-- Game/Code/Classes/UModules.pas | 9 +- Game/Code/Classes/UPluginInterface.pas | 48 +- Game/Code/Classes/UServices.pas | 14 +- Game/Code/Classes/uPluginLoader.pas | 786 +++++++++++++++++++++++++++++++++ 7 files changed, 947 insertions(+), 76 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index de44fb3b..a8a29aeb 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -38,6 +38,7 @@ type sRetranslate: THandle; sReloadTextures: THandle; sGetModuleInfo: THandle; + sGetApplicationHandle: THandle; Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; @@ -86,6 +87,9 @@ type //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: //-------------- @@ -95,6 +99,7 @@ type Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle end; var @@ -354,6 +359,10 @@ begin 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); end; //------------- @@ -374,6 +383,21 @@ begin // to-do : write TService-/HookManager.Free and call it here 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 + If (Modules[I].Info.Name = Name) then + begin + Result := @Modules[I].Module; + Break; + end; +end; + //------------- // Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) //------------- @@ -405,11 +429,11 @@ end; //------------- Function TCore.ReportError(wParam, lParam: DWord): integer; begin - Hooks.CallEventChain(hError, wParam, lParam); - //Update LastErrorReporter and LastErrorString LastErrorReporter := String(PChar(Ptr(lParam))); LastErrorString := String(PChar(Ptr(wParam))); + + Hooks.CallEventChain(hError, wParam, lParam); end; //------------- @@ -460,4 +484,12 @@ begin end; end; +//------------- +// Returns Application Handle +//------------- +Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer; +begin + Result := hInstance; +end; + end. \ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index 6fca5d37..e5a874f0 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -13,10 +13,13 @@ uses UPluginDefs; {$ENDIF} type + PCoreModule = ^TCoreModule; TCoreModule = class public + Constructor Create; virtual; + //Function that gives some Infos about the Module to the Core - Procedure Info(const pInfo: PModuleInfo); + Procedure Info(const pInfo: PModuleInfo); virtual; //Is Called on Loading. //In this Method only Events and Services should be created @@ -47,6 +50,14 @@ type implementation +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) +end; + //------------- // Function that gives some Infos about the Module to the Core //------------- diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index c73ccbbb..c3684ed1 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -6,7 +6,7 @@ unit UHooks; Saves all hookable events and their subscribers *********************} interface -uses uPluginDefs, SysUtils, WINDOWS; +uses uPluginDefs, SysUtils; {$IFDEF FPC} {$MODE Delphi} @@ -21,6 +21,8 @@ type Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) Next: PSubscriberInfo; //Pointer to next Item in HookChain + Owner: Integer; //For Error Handling and Plugin Unloading. + //Here is s/t tricky //To avoid writing of Wrapping Functions to Hook an Event with a Class //We save a Normal Proc or a Method of a Class @@ -39,6 +41,8 @@ type private Events: array of TEventInfo; SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); public constructor Create(const SpacetoAllocate: Word); @@ -50,15 +54,17 @@ type Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); end; function HookTest(wParam, lParam: DWord): integer; stdcall; -function HookTest2(wParam, lParam: DWord): integer; stdcall; var HookManager: THookManager; implementation +uses UCore; //------------ // Create - Creates Class and Set Standard Values @@ -192,6 +198,9 @@ begin //Fill it with Data Cur.Next := nil; + //Add Owner + Cur.Owner := Core.CurExecuted; + If (@Proc = nil) then begin //Use the ProcofClass Method Cur.isClass := True; @@ -228,12 +237,37 @@ begin Events[EventIndex].LastSubscriber := Cur; {$IFDEF DEBUG} - WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''); + WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); {$ENDIF} end; end; end; +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + //------------ // DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure //------------ @@ -259,24 +293,7 @@ begin begin If (Cur.Self = hSubscriber) then begin //Found Subscription we searched for - //Delete from Chain - If (Last <> nil) then - begin - Last.Next := Cur.Next; - end - else //Was first Popup - begin - Events[EventIndex].FirstSubscriber := Cur.Next; - end; - - //Was this Last subscription ? - If (Cur = Events[EventIndex].LastSubscriber) then - begin //Change Last Subscriber - Events[EventIndex].LastSubscriber := Last; - end; - - //Free Space: - FreeMem(Cur, SizeOf(TSubscriberInfo)); + FreeSubscriber(EventIndex, Last, Cur); {$IFDEF DEBUG} WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); @@ -303,18 +320,24 @@ Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lPara var EventIndex: Cardinal; Cur: PSubscriberInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute begin Result := -1; EventIndex := hEvent - 1; If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + //Start calling the Chain !!!11 Cur := Events[EventIndex].FirstSubscriber; Result := 0; //Call Hooks until the Chain is at the End or breaked While ((Cur <> nil) AND (Result = 0)) do begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; if (Cur.isClass) then Result := Cur.ProcOfClass(wParam, lParam) else @@ -322,6 +345,9 @@ begin Cur := Cur.Next; end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; end; {$IFDEF DEBUG} @@ -354,22 +380,49 @@ begin end; end; - -function HookTest(wParam, lParam: DWord): integer; stdcall; -var Test: String[60]; -var T2: String; +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +Procedure THookManager.DelbyOwner(const Owner: Integer); +var + I: Integer; + Cur, Last: PSubscriberInfo; begin - Messagebox(0, 'Test', 'test', MB_ICONWARNING or MB_OK); - - Result := 0; //Don't break the chain + //Search for Owner in all Hooks Chains + For I := 0 to High(Events) do + begin + If (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + While (Cur <> nil) do + begin + If (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + If (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + Else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; end; -function HookTest2(wParam, lParam: DWord): integer; stdcall; -begin - //Showmessage(String(PCHAR(Ptr(lParam))); - Messagebox(0, Ptr(lParam), 'test', MB_ICONWARNING or MB_OK); +function HookTest(wParam, lParam: DWord): integer; stdcall; +begin Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Ptr(lParam))) + ': ' + String(PChar(Ptr(wParam)))))); end; end. diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas index e8e759ff..c126e9ee 100644 --- a/Game/Code/Classes/UModules.pas +++ b/Game/Code/Classes/UModules.pas @@ -8,11 +8,14 @@ interface *********************} uses - UCoreModule; + UCoreModule, + uPluginLoader; const - CORE_MODULES_TO_LOAD: Array[0..0] of cCoreModule = ( - TCoreModule //Remove this later, just a dummy + 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 diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas index 6d17d51d..a9cc7e46 100644 --- a/Game/Code/Classes/UPluginInterface.pas +++ b/Game/Code/Classes/UPluginInterface.pas @@ -8,11 +8,6 @@ unit uPluginInterface; interface uses uPluginDefs; -//--------------- -// Procedure that Sets the PluginInterface Record -//--------------- - Procedure Init_PluginInterface; - //--------------- // Methods for Plugin //--------------- @@ -59,29 +54,8 @@ uses uPluginDefs; otherwise 0} Function ServiceExists (ServiceName: PChar): Integer; stdcall; -var - PluginInterface: TUS_PluginInterface; - implementation - -//--------------- -// Procedure that Sets the PluginInterface Record -//--------------- -Procedure Init_PluginInterface; -begin - 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; -end; - +uses UCore; {******** Hook specific Methods ********} //--------------- @@ -90,7 +64,7 @@ end; //--------------- Function CreateHookableEvent (EventName: PChar): THandle; stdcall; begin - + Result := Core.Hooks.AddEvent(EventName); end; //--------------- @@ -99,7 +73,7 @@ end; //--------------- Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; begin - + Result := Core.Hooks.DelEvent(hEvent); end; //--------------- @@ -109,7 +83,7 @@ end; //--------------- Function NotivyEventHooks (hEvent: THandle; wParam, lParam: dWord): integer; stdcall; begin - + Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); end; //--------------- @@ -118,7 +92,7 @@ end; //--------------- Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; begin - + Result := Core.Hooks.AddSubscriber(EventName, HookProc); end; //--------------- @@ -127,7 +101,7 @@ end; //--------------- Function UnHookEvent (hHook: THandle): Integer; stdcall; begin - + Result := Core.Hooks.DelSubscriber(hHook); end; //--------------- @@ -136,7 +110,7 @@ end; //--------------- Function EventExists (EventName: PChar): Integer; stdcall; begin - + Result := Core.Hooks.EventExists(EventName); end; {******** Service specific Methods ********} @@ -146,7 +120,7 @@ end; //--------------- Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; begin - + Result := Core.Services.AddService(ServiceName, ServiceProc); end; //--------------- @@ -155,7 +129,7 @@ end; //--------------- Function DestroyService (hService: THandle): integer; stdcall; begin - + Result := Core.Services.DelService(hService); end; //--------------- @@ -164,7 +138,7 @@ end; //--------------- Function CallService (ServiceName: PChar; wParam, lParam: dWord): integer; stdcall; begin - + Result := Core.Services.CallService(ServiceName, wParam, lParam); end; //--------------- @@ -173,7 +147,7 @@ end; //--------------- 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 fce81bd8..0028576b 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -22,7 +22,7 @@ type 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] + 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 @@ -63,6 +63,7 @@ var ServiceManager: TServiceManager; implementation +uses UCore; //------------ // Create - Creates Class and Set Standard Values @@ -125,6 +126,9 @@ begin 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; @@ -208,18 +212,26 @@ Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lPa 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 := ptr(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} diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 929fd84e..fadea0c6 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -1,7 +1,793 @@ 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 +uses UPluginDefs, UCoreModule; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +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; + Procedure Free; 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, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 win32} + PluginFileExtension = '.dll'; + {$ELSE} + PluginFileExtension = '.so'; + {$ENDIF} implementation +uses UCore, UPluginInterface, +{$IFDEF win32} + 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 + //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.')), Integer(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 +//------------- +Procedure TPluginLoader.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); +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)), Integer(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)), Integer(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: ' + Info.Name)), Integer(PChar('TPluginLoader'))); + + //Unload Old Plugin + UnloadPlugin(Integer(nil), PluginID); + + //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)), Integer(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: ' + Info.Name)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(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: ' + Plugins[Index].Info.Name)), Integer(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: ' + Plugins[Index].Info.Name)), Integer(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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + If (Ptr(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sFile := String(PChar(Ptr(wParam))); + 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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sName: String; +begin + Result := -1; + //lParam is ID + If (Ptr(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(Ptr(wParam))); + 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, lParam: DWord): integer; +var I: Integer; +begin + Result := 0; + If (wParam < 0) then + begin //Get Info of 1 Plugin + If (Ptr(lParam) <> nil) AND (wParam < Length(Plugins)) then + begin + Try + Result := 1; + PUS_PluginInfo(Ptr(lParam))^ := Plugins[wParam].Info; + Except + + End; + end; + end + Else If (Ptr(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(Ptr(lParam))^[I] := Plugins[I].Info; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Ptr(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(Ptr(lParam + I)^) := Plugins[I].State; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(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 + 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 +label Continue; +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')), Integer(PChar('TtehPlugins'))); + end + else + begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + Core.CurExecuted := -1 - I; + + //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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + Inc(I); + 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 + '"')), Integer(PChar('TtehPlugins'))); + + + //don't forget to increase I + Inc(I); + end; + End; + + If (I <= High(PluginLoader.Plugins)) then + Goto Continue; + + //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 +label Continue; +begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + 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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + end; + 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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + End; + + If (I <= High(PluginLoader.Plugins)) then + GoTo Continue; + + //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 +label Continue; +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + I := 0; + + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + //DeInit Plugin + PluginLoader.CallDeInit(I); + + Inc(I); + end; + Except + Inc(I); + End; + + If I <= High(PluginLoader.Plugins) then + Goto Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; end. -- cgit v1.2.3 From 5802c7be05f25e5da3a991377942c00ee7d95639 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 27 Oct 2007 09:36:49 +0000 Subject: try to fix build errors git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@537 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 2 +- Game/Code/Classes/UModules.pas | 2 +- Game/Code/Classes/uPluginLoader.pas | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index a8a29aeb..9c31e79a 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -1,7 +1,7 @@ unit UCore; interface -uses uPluginDefs, uCoreModule, UHooks, UServices, uModules; +uses uPluginDefs, uCoreModule, UHooks, UServices, UModules; {********************* TCore Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas index c126e9ee..493fc393 100644 --- a/Game/Code/Classes/UModules.pas +++ b/Game/Code/Classes/UModules.pas @@ -9,7 +9,7 @@ interface uses UCoreModule, - uPluginLoader; + UPluginLoader; const CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index fadea0c6..442e76e0 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -1,6 +1,6 @@ -unit uPluginLoader; +unit UPluginLoader; {********************* - uPluginLoader + UPluginLoader Unit contains to Classes TPluginLoader: Class Searching for and Loading the Plugins TtehPlugins: Class that represents the Plugins in Modules chain -- cgit v1.2.3 From 2fdee21c44d16fa2a521380672f8868565bb4df5 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 29 Oct 2007 23:09:04 +0000 Subject: fixed build error since build#USDX-LAZLIN-65 doh :( git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@542 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 111 ++++++++++++++++++++++++++++++------------- 1 file changed, 77 insertions(+), 34 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index e3c54ac4..5ce35201 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -134,14 +134,15 @@ end; procedure TSongs.BrowseDir(Dir: widestring); var - SR: TSearchRecW; // for parsing Songs Directory SLen: integer; - {$ifndef win32} - TheDir : pdir; - ADirent :pDirent; - Entry : Longint; - info : stat; + {$ifdef win32} + SR: TSearchRecW; // for parsing Songs Directory + {$else} // This should work on all posix systems. + TheDir : pdir; + ADirent : pDirent; + Entry : Longint; + info : stat; {$endif} begin {$ifdef win32} @@ -155,6 +156,37 @@ begin until FindNextw(SR) <> 0; end; // if FindClosew(SR); + + if FindFirstW(Dir + '*.txt', 0, SR) = 0 then + begin + repeat + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNextW(SR) <> 0; + end; // if FindFirst + FindCloseW(SR); + {$else} // Itterate the Songs Directory... ( With unicode capable functions for linux ) TheDir := opendir( Dir ); // JB_Unicode - linux @@ -175,39 +207,50 @@ begin end; Until ADirent=Nil; end; - {$endif} - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + - if FindFirstW(Dir + '*.txt', 0, SR) = 0 then - begin - repeat - SLen := BrowsePos; + TheDir := opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := ReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.name ) > -1 ) then + begin + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; + Until ADirent=Nil; + end; // if FindFirst - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; + {$endif} + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - until FindNextW(SR) <> 0; - end; // if FindFirst - FindCloseW(SR); end; procedure TSongs.Sort(Order: integer); -- cgit v1.2.3 From 391d30716d48dc709f6444b19c008e82311623b9 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 1 Nov 2007 19:34:40 +0000 Subject: Mac OS X version compiles and links. I hope I didn't break too many files on windows/linux. Added switches.inc to all files. Changed many IFDEFs. For Windows-only code please use MSWINDOWS instead of WIN32 now. WIN32 is also used by the Mac port. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@546 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 10 +- Game/Code/Classes/UAudio_FFMpeg.pas | 8 +- Game/Code/Classes/UAudio_bass.pas | 20 +- Game/Code/Classes/UCatCovers.pas | 3 + Game/Code/Classes/UCommandLine.pas | 3 + Game/Code/Classes/UCommon.pas | 196 ++-- Game/Code/Classes/UCore.pas | 985 ++++++++++---------- Game/Code/Classes/UCoreModule.pas | 7 +- Game/Code/Classes/UCovers.pas | 4 +- Game/Code/Classes/UDLLManager.pas | 17 +- Game/Code/Classes/UDataBase.pas | 5 +- Game/Code/Classes/UDraw.pas | 8 +- Game/Code/Classes/UFiles.pas | 4 +- Game/Code/Classes/UGraphic.pas | 4 - Game/Code/Classes/UGraphicClasses.pas | 4 - Game/Code/Classes/UHooks.pas | 9 +- Game/Code/Classes/UIni.pas | 4 +- Game/Code/Classes/ULCD.pas | 1 + Game/Code/Classes/ULanguage.pas | 6 +- Game/Code/Classes/ULight.pas | 8 +- Game/Code/Classes/ULog.pas | 10 +- Game/Code/Classes/ULyrics.pas | 4 - Game/Code/Classes/ULyrics_bak.pas | 4 - Game/Code/Classes/UMain.pas | 275 +++++- Game/Code/Classes/UMedia_dummy.pas | 5 +- Game/Code/Classes/UModules.pas | 3 + Game/Code/Classes/UMusic.pas | 4 - Game/Code/Classes/UParty.pas | 5 +- Game/Code/Classes/UPlaylist.pas | 6 +- Game/Code/Classes/UPliki.pas | 2 + Game/Code/Classes/UPluginInterface.pas | 3 + Game/Code/Classes/URecord.pas | 4 - Game/Code/Classes/UServices.pas | 11 +- Game/Code/Classes/USingNotes.pas | 3 + Game/Code/Classes/USingScores.pas | 8 +- Game/Code/Classes/USkins.pas | 7 +- Game/Code/Classes/USongs.pas | 88 +- Game/Code/Classes/UTextClasses.pas | 3 + Game/Code/Classes/UTexture.pas | 12 +- Game/Code/Classes/UThemes.pas | 4 +- Game/Code/Classes/UTime.pas | 4 +- Game/Code/Classes/UVideo.pas | 4 +- Game/Code/Classes/uPluginLoader.pas | 1582 ++++++++++++++++---------------- 43 files changed, 1825 insertions(+), 1532 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index fbe9a050..af60c4ff 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -2,9 +2,7 @@ unit TextGL; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses OpenGL12, @@ -80,7 +78,7 @@ uses UMain, lcltype, {$ENDIF} SysUtils, - {$IFDEF FPC} + {$IFDEF LAZARUS} LResources, {$ENDIF} UGraphic; @@ -88,7 +86,7 @@ uses UMain, procedure BuildFont; // Build Our Bitmap Font procedure loadfont( aID : integer; aType, aResourceName : String); - {$IFDEF FPC} + {$IFDEF LAZARUS} var lLazRes : TLResource; lResData : TStringStream; @@ -541,7 +539,7 @@ begin end; -{$IFDEF FPC} +{$IFDEF LAZARUS} {$IFDEF win32} initialization {$I UltraStar.lrs} diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 35822a3b..675dfd3c 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -13,9 +13,7 @@ This unit is primarily based upon - interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses Classes, @@ -67,7 +65,7 @@ type implementation uses - {$IFDEF FPC} + {$IFDEF LAZARUS} lclintf, libc, {$ENDIF} @@ -590,7 +588,7 @@ begin len1 := len; - {$ifdef win32} + {$ifdef WIN32} lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); CopyMemory(stream, lSrc , len1); {$else} diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 985eede5..463a6c7f 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -2,9 +2,7 @@ unit UAudio_bass; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses Classes, @@ -24,7 +22,7 @@ uses Classes, implementation uses - {$IFDEF FPC} + {$IFDEF LAZARUS} lclintf, {$ENDIF} URecord, @@ -111,7 +109,7 @@ var function TAudio_bass.GetName: String; begin - result := 'BASS'; + result := 'BASS'; end; procedure TAudio_bass.InitializePlayback; @@ -637,11 +635,11 @@ initialization writeln( 'UAudio_Bass - Register Input' ); AudioManager.add( IAudioInput( singleton_MusicBass ) ); -finalization - writeln( 'UAudio_Bass - UnRegister Playback' ); - AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) ); - - writeln( 'UAudio_Bass - UnRegister Input' ); - AudioManager.Remove( IAudioInput( singleton_MusicBass ) ); +finalization + writeln( 'UAudio_Bass - UnRegister Playback' ); + AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) ); + + writeln( 'UAudio_Bass - UnRegister Input' ); + AudioManager.Remove( IAudioInput( singleton_MusicBass ) ); end. diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas index d40b2564..b1c91e48 100644 --- a/Game/Code/Classes/UCatCovers.pas +++ b/Game/Code/Classes/UCatCovers.pas @@ -5,6 +5,9 @@ unit UCatCovers; ///////////////////////////////////////////////////////////////////////// interface + +{$I switches.inc} + uses UIni; type diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 259c6e16..1539ffaf 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -2,6 +2,9 @@ unit UCommandLine; interface +{$I switches.inc} + + type //----------- // TCMDParams - Class Reaads Infos from ParamStr and set some easy Interface Variables diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 44ec6bb3..b532f775 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -2,16 +2,17 @@ unit UCommon; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses SysUtils, -{$IFDEF FPC} +{$IFDEF LAZARUS} lResources, {$ENDIF} ULog, +{$IFDEF DARWIN} + messages, +{$ENDIF} {$IFDEF win32} windows; {$ELSE} @@ -27,22 +28,23 @@ type TWin32FindData = LongInt; {$ENDIF} -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; +{$IFDEF LAZARUS} + function LazFindResource( const aName, aType : String ): TLResource; +{$ENDIF} -function LazFindResource( const aName, aType : String ): TLResource; +{$IFDEF FPC} function RandomRange(aMin: Integer; aMax: Integer) : Integer; function MaxValue(const Data: array of Double): Double; function MinValue(const Data: array of Double): Double; -{$IFDEF Win32} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} // Win32 + {$IFDEF WIN32} + type + TWndMethod = procedure(var Message: TMessage) of object; + function AllocateHWnd(Method: TWndMethod): HWND; + procedure DeallocateHWnd(Wnd: HWND); + {$ENDIF} // Win32 {$ENDIF} // FPC Only @@ -58,24 +60,24 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} -{$IFDEF Win32} +{$IFDEF MSWINDOWS} 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; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; + 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; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; {$endif} implementation @@ -143,7 +145,7 @@ end; {$ENDIF} -{$IFDEF FPC} +{$IFDEF LAZARUS} function LazFindResource( const aName, aType : String ): TLResource; var @@ -161,7 +163,9 @@ begin end; end; end; +{$ENDIF} +{$IFDEF FPC} function MaxValue(const Data: array of Double): Double; var I: Integer; @@ -191,7 +195,7 @@ end; // NOTE !!!!!!!!!! // AllocateHWnd is in lclintfh.inc -{$IFDEF Win32} +{$IFDEF MSWINDOWS} // TODO : JB this is dodgey and bad... find a REAL solution ! function AllocateHWnd(Method: TWndMethod): HWND; var @@ -209,72 +213,82 @@ begin DestroyWindow(Wnd); end; {$ENDIF} +{$IFDEF DARWIN} +// TODO : Situation for the mac isn't better ! +function AllocateHWnd(Method: TWndMethod): HWND; +begin +end; + +procedure DeallocateHWnd(Wnd: HWND); +begin +end; +{$ENDIF} + - {$ENDIF} -{$ifdef win32} -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; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - 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 - if FindNextFileW(F.FindHandle, F.FindData) then - 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 - if not FindNextFileW(FindHandle, FindData) then - 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; +{$ifdef MSWINDOWS} +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; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + 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 + if FindNextFileW(F.FindHandle, F.FindData) then + 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 + if not FindNextFileW(FindHandle, FindData) then + 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; {$endif} diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 9c31e79a..091868f2 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -1,495 +1,492 @@ -unit UCore; - -interface -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 ;) -*********************} - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -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; - - //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 - - CurExecuted: Integer; //ID of Plugin or Module curently Executed - - 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 - - - //--------------- - //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook - Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook - Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle - end; - -var - Core: TCore; - -implementation -uses SysUtils, -{$IFDEF win32} -Windows -{$ENDIF}; - -//------------- -// Create - Creates Class + Hook and Service Manager -//------------- -Constructor TCore.Create(const cName: String; const cVersion: LongWord); -begin - Name := cName; - Version := cVersion; - CurExecuted := 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 - noError: Boolean; -begin - //Get Modules - Try - noError := GetModules; - Except - noError := False; - end; - - //Loading - if (noError) then - begin - Try - noError := Load; - Except - noError := False; - end; - - if (noError) then - begin //Init - Try - noError := Init; - Except - noError := False; - end; - - If noError then - begin - //Call Translate Hook - noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0); - - If noError then - begin //Calls LoadTextures Hook - noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0); - - if noError then - begin //Calls Loading Finished Hook - noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0); - - If noError then - begin - //Start MainLoop - While noError do - begin - noError := MainLoop; - // to-do : Call Display Draw here - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); - end; - - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); - end; - - //DeInit - DeInit; -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; - try - For I := 0 to high(Modules) do - begin - Modules[I].NeedsDeInit := False; - Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; - Modules[I].Module.Info(@Modules[I].Info); - end; - Result := True; - except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; -end; - -//------------- -//Loads Core and all Modules -//------------- -Function TCore.Load: Boolean; -var - I: Integer; -begin - Result := LoadCore; - - I := 0; - While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do - begin - try - Result := Modules[I].Module.Load; - except - Result := False; - ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; - - Inc(I); - end; -end; - -//------------- -//Inits Core and all Modules -//------------- -Function TCore.Init: Boolean; -var - I: Integer; -begin - Result := InitCore; - - I := 0; - While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do - begin - try - Result := Modules[I].Module.Init; - except - Result := False; - ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; - - Modules[I].NeedsDeInit := Result; - Inc(I); - end; -end; - -//------------- -//DeInits Core and all Modules -//------------- -Function TCore.DeInit: Boolean; -var - I: Integer; -label Continue; -begin - I := High(CORE_MODULES_TO_LOAD); - - Continue: - Try - While (I >= 0) do - begin - If (Modules[I].NeedsDeInit) then - Modules[I].Module.DeInit; - - Dec(I); - end; - Except - - - end; - If (I >= 0) then - GoTo Continue; - - DeInitCore; -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); -end; - -//------------- -//Init the Core -//------------- -Function TCore.InitCore: Boolean; -begin - //Dont Init s.th. atm. -end; - -//------------- -//DeInit the Core -//------------- -Function TCore.DeInitCore: Boolean; -begin - - - // to-do : write TService-/HookManager.Free and call it here -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 - If (Modules[I].Info.Name = Name) then - begin - Result := @Modules[I].Module; - Break; - end; -end; - -//------------- -// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) -//------------- -Function TCore.ShowMessage(wParam, lParam: DWord): integer; -var Params: Cardinal; -begin - Result := -1; - - {$IFDEF win32} - If (ptr(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; - - //Anzeigen: - Result := Messagebox(0, ptr(lParam), PChar(Name), Params); - end; - {$ENDIF} - - // to-do : write ShowMessage for other OSes -end; - -//------------- -// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -Function TCore.ReportError(wParam, lParam: DWord): integer; -begin - //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(Ptr(lParam))); - LastErrorString := String(PChar(Ptr(wParam))); - - Hooks.CallEventChain(hError, wParam, lParam); -end; - -//------------- -// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -Function TCore.ReportDebug(wParam, lParam: DWord): integer; -begin - Hooks.CallEventChain(hDebug, wParam, lParam); -end; - -//------------- -// Calls Translate hook -//------------- -Function TCore.Retranslate(wParam, lParam: DWord): integer; -begin - Hooks.CallEventChain(hTranslate, 0, 1); -end; - -//------------- -// Calls LoadTextures hook -//------------- -Function TCore.ReloadTextures(wParam, lParam: DWord): integer; -begin - Hooks.CallEventChain(hLoadTextures, 0, 1); -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, lParam: DWord): integer; -begin - if (ptr(lParam) = nil) then - begin - Result := Length(Modules); - end - else - begin - Try - For Result := 0 to High(Modules) do - begin - AModuleInfo(ptr(lParam))[Result].Name := Modules[Result].Info.Name; - AModuleInfo(ptr(lParam))[Result].Version := Modules[Result].Info.Version; - AModuleInfo(ptr(lParam))[Result].Description := Modules[Result].Info.Description; - end; - Except - Result := -1; - end; - end; -end; - -//------------- -// Returns Application Handle -//------------- -Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer; -begin - Result := hInstance; -end; - +unit UCore; + +interface + +{$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; + + //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 + + CurExecuted: Integer; //ID of Plugin or Module curently Executed + + 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 + + + //--------------- + //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook + Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook + Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle + end; + +var + Core: TCore; + +implementation +uses SysUtils, +{$IFDEF win32} +Windows +{$ENDIF}; + +//------------- +// Create - Creates Class + Hook and Service Manager +//------------- +Constructor TCore.Create(const cName: String; const cVersion: LongWord); +begin + Name := cName; + Version := cVersion; + CurExecuted := 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 + noError: Boolean; +begin + //Get Modules + Try + noError := GetModules; + Except + noError := False; + end; + + //Loading + if (noError) then + begin + Try + noError := Load; + Except + noError := False; + end; + + if (noError) then + begin //Init + Try + noError := Init; + Except + noError := False; + end; + + If noError then + begin + //Call Translate Hook + noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0); + + If noError then + begin //Calls LoadTextures Hook + noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0); + + if noError then + begin //Calls Loading Finished Hook + noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0); + + If noError then + begin + //Start MainLoop + While noError do + begin + noError := MainLoop; + // to-do : Call Display Draw here + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); + end; + + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); + end; + + //DeInit + DeInit; +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; + try + For I := 0 to high(Modules) do + begin + Modules[I].NeedsDeInit := False; + Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; + Modules[I].Module.Info(@Modules[I].Info); + end; + Result := True; + except + ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; +end; + +//------------- +//Loads Core and all Modules +//------------- +Function TCore.Load: Boolean; +var + I: Integer; +begin + Result := LoadCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + try + Result := Modules[I].Module.Load; + except + Result := False; + ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + + Inc(I); + end; +end; + +//------------- +//Inits Core and all Modules +//------------- +Function TCore.Init: Boolean; +var + I: Integer; +begin + Result := InitCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + try + Result := Modules[I].Module.Init; + except + Result := False; + ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + + Modules[I].NeedsDeInit := Result; + Inc(I); + end; +end; + +//------------- +//DeInits Core and all Modules +//------------- +Function TCore.DeInit: Boolean; +var + I: Integer; +label Continue; +begin + I := High(CORE_MODULES_TO_LOAD); + + Continue: + Try + While (I >= 0) do + begin + If (Modules[I].NeedsDeInit) then + Modules[I].Module.DeInit; + + Dec(I); + end; + Except + + + end; + If (I >= 0) then + GoTo Continue; + + DeInitCore; +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); +end; + +//------------- +//Init the Core +//------------- +Function TCore.InitCore: Boolean; +begin + //Dont Init s.th. atm. +end; + +//------------- +//DeInit the Core +//------------- +Function TCore.DeInitCore: Boolean; +begin + + + // to-do : write TService-/HookManager.Free and call it here +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 + If (Modules[I].Info.Name = Name) then + begin + Result := @Modules[I].Module; + Break; + end; +end; + +//------------- +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +Function TCore.ShowMessage(wParam, lParam: DWord): integer; +var Params: Cardinal; +begin + Result := -1; + + {$IFDEF MSWINDOWS} + If (ptr(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; + + //Anzeigen: + Result := Messagebox(0, ptr(lParam), PChar(Name), Params); + end; + {$ENDIF} + + // to-do : write ShowMessage for other OSes +end; + +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +Function TCore.ReportError(wParam, lParam: DWord): integer; +begin + //Update LastErrorReporter and LastErrorString + LastErrorReporter := String(PChar(Pointer(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, lParam: DWord): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); +end; + +//------------- +// Calls Translate hook +//------------- +Function TCore.Retranslate(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hTranslate, 0, 1); +end; + +//------------- +// Calls LoadTextures hook +//------------- +Function TCore.ReloadTextures(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hLoadTextures, 0, 1); +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, lParam: DWord): 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, lParam: DWord): integer; +begin + Result := hInstance; +end; + end. \ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index e5a874f0..b135089c 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -1,6 +1,9 @@ unit UCoreModule; interface + +{$I switches.inc} + {********************* TCoreModule Dummy Class that has Methods that will be called from Core @@ -8,10 +11,6 @@ interface *********************} uses UPluginDefs; -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - type PCoreModule = ^TCoreModule; TCoreModule = class diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index 966277cd..f4ede329 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -2,9 +2,7 @@ unit UCovers; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses OpenGL12, {$IFDEF win32} diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index ff6c16a4..358be9af 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -1,12 +1,9 @@ unit UDLLManager; -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - interface +{$I switches.inc} + uses ModiSDK, UFiles; @@ -44,15 +41,19 @@ var const DLLPath = 'Plugins'; - {$IFDEF win32} + {$IFDEF MSWINDOWS} DLLExt = '.dll'; - {$ELSE} + {$ENDIF} + {$IFDEF LINUX} DLLExt = '.so'; {$ENDIF} + {$IFDEF DARWIN} + DLLExt = '.dylib'; + {$ENDIF} implementation -uses {$IFDEF win32} +uses {$IFDEF MSWINDOWS} windows, {$ELSE} dynlibs, diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index bacb0d98..0cafc9fd 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -2,10 +2,7 @@ unit UDataBase; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} uses USongs, SQLiteTable3; diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 2a5528b8..350926d8 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -2,9 +2,7 @@ unit UDraw; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} +{$I switches.inc} uses UThemes, ModiSDK, @@ -243,7 +241,7 @@ begin lTmpA := (Right-Left); lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - {$IFDEF FPC} + {$IFDEF LAZARUS} (* writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); writeln( 'UDRAW : ' + floattostr( lTmpB ) ); @@ -479,7 +477,7 @@ begin lTmpA := (Right-Left); lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - {$IFDEF FPC} + {$IFDEF LAZARUS} {* writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); writeln( 'UDRAW : ' + floattostr( lTmpB ) ); diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 717d20e2..5f168ead 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -2,9 +2,7 @@ unit UFiles; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses SysUtils, ULog, diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 5847e41c..26601f2d 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -4,10 +4,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - uses SDL, OpenGL12, diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index c04a0ad8..2acd5530 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -5,10 +5,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - uses UTexture; const DelayBetweenFrames : Cardinal = 60; diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index c3684ed1..ea31ec50 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -6,14 +6,11 @@ unit UHooks; Saves all hookable events and their subscribers *********************} interface -uses uPluginDefs, SysUtils; -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - {$I switches.inc} +uses uPluginDefs, SysUtils; + type //Record that saves info from Subscriber PSubscriberInfo = ^TSubscriberInfo; @@ -422,7 +419,7 @@ end; function HookTest(wParam, lParam: DWord): integer; stdcall; begin Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Ptr(lParam))) + ': ' + String(PChar(Ptr(wParam)))))); + Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); end; end. diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 6b7f3cea..36ba2180 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -2,9 +2,7 @@ unit UIni; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} +{$I switches.inc} uses IniFiles, ULog, SysUtils; diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas index 50214ad0..13736729 100644 --- a/Game/Code/Classes/ULCD.pas +++ b/Game/Code/Classes/ULCD.pas @@ -1,6 +1,7 @@ unit ULCD; interface + {$I switches.inc} type diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index 679f6405..25986263 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -2,10 +2,8 @@ unit ULanguage; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} + type TLanguageEntry = record diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 99edc88c..6621cf59 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -2,10 +2,6 @@ unit ULight; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - {$I switches.inc} type @@ -55,7 +51,11 @@ uses begin GetLocalTime(SystemTime); with SystemTime do +{$IFDEF DARWIN} + Result := EncodeTime(Hour, Minute, Second, MilliSecond); +{$ELSE} Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); +{$ENDIF} end; {$ELSE} Type diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 7e464b57..2ce70a11 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -4,10 +4,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - uses Classes; type @@ -191,7 +187,7 @@ begin {$DEFINE DEBUG} //How can i check if this is set in *.dpr file o0 //If Debug => Write to Console Output {$IFDEF DEBUG} - WriteLn('Error: ' + Text); + WriteLn('Error: ' + Text); {$ENDIF} end; @@ -229,7 +225,7 @@ begin //If Debug => Write to Console Output {$IFDEF DEBUG} - WriteLn(Log2 + ': ' + Log1); + WriteLn(Log2 + ': ' + Log1); {$ENDIF} end; @@ -243,7 +239,7 @@ begin //Write Error to Logfile: LogError (Text); - {$IFDEF win32} + {$IFDEF MSWINDOWS} //Show Errormessage Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); {$ELSE} diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index e4ac2024..96b9d43b 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -2,10 +2,6 @@ unit ULyrics; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - {$I switches.inc} uses OpenGL12, diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas index 43fa46f5..b5a9d798 100644 --- a/Game/Code/Classes/ULyrics_bak.pas +++ b/Game/Code/Classes/ULyrics_bak.pas @@ -2,10 +2,6 @@ unit ULyrics_bak; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - {$I switches.inc} uses SysUtils, diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 82fb92e4..bbc64f80 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -2,10 +2,6 @@ unit UMain; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - {$I switches.inc} uses @@ -119,6 +115,7 @@ var procedure InitializePaths; +Procedure Main; procedure MainLoop; procedure CheckEvents; procedure Sing(Sender: TScreenSing); @@ -133,7 +130,275 @@ function GetTimeFromBeat(Beat: integer): real; procedure ClearScores(PlayerNum: integer); implementation -uses USongs, UJoystick, math, UCommandLine; + +uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, + USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, + UParty, UCore, UGraphicClasses, UPluginDefs; + +const + Version = 'UltraStar Deluxe V 1.10 Alpha Build'; + +{$IFDEF WIN32} +Procedure Main; +var + WndTitle: string; + hWnd: THandle; + I: Integer; +begin + WndTitle := Version; + +// InitializeSound(); +// writeln( 'DONE' ); +// exit; + + + {$IFDEF MSWINDOWS} + //------------------------------ + //Start more than One Time Prevention + //------------------------------ + 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 + Exit; + end; + {$ENDIF} + + //------------------------------ + //StartUp - Create Classes and Load Files + //------------------------------ + USTime := TTime.Create; + + // Commandline Parameter Parser + Params := TCMDParams.Create; + + // Log + Benchmark + Log := TLog.Create; + Log.Title := WndTitle; + Log.Enabled := Not Params.NoLog; + Log.BenchmarkStart(0); + + // Language + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Paths', 'Initialization'); + InitializePaths; + Log.LogStatus('Load Language', 'Initialization'); + Language := TLanguage.Create; + //Add Const Values: + Language.AddConst('US_VERSION', Version); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Language', 1); + + // SDL + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL', 'Initialization'); + SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL', 1); + + // SDL_ttf + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL_ttf', 'Initialization'); + TTF_Init(); //ttf_quit(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL_ttf', 1); + + // Skin + Log.BenchmarkStart(1); + Log.LogStatus('Loading Skin List', 'Initialization'); + Skin := TSkin.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Skin List', 1); + + // Sound Card List + Log.BenchmarkStart(1); + Log.LogStatus('Loading Soundcard list', 'Initialization'); + Recording := TRecord.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Soundcard list', 1); + + // Ini + Paths + Log.BenchmarkStart(1); + Log.LogStatus('Load Ini', 'Initialization'); + Ini := TIni.Create; + Ini.Load; + + //Load Languagefile + if (Params.Language <> -1) then + Language.ChangeLanguage(ILanguage[Params.Language]) + else + Language.ChangeLanguage(ILanguage[Ini.Language]); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Ini', 1); + + + // LCD + Log.BenchmarkStart(1); + Log.LogStatus('Load LCD', 'Initialization'); + LCD := TLCD.Create; + if Ini.LPT = 1 then begin +// LCD.HalfInterface := true; + LCD.Enable; + LCD.Clear; + LCD.WriteText(1, ' UltraStar '); + LCD.WriteText(2, ' Loading... '); + end; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading LCD', 1); + + // Light + Log.BenchmarkStart(1); + Log.LogStatus('Load Light', 'Initialization'); + Light := TLight.Create; + if Ini.LPT = 2 then begin + Light.Enable; + end; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Light', 1); + + + + // Theme + Log.BenchmarkStart(1); + Log.LogStatus('Load Themes', 'Initialization'); + Theme := TTheme.Create('Themes\' + ITheme[Ini.Theme] + '.ini', Ini.Color); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Themes', 1); + + // Covers Cache + Log.BenchmarkStart(1); + Log.LogStatus('Creating Covers Cache', 'Initialization'); + Covers := TCovers.Create; + Log.LogBenchmark('Loading Covers Cache Array', 1); + Log.BenchmarkStart(1); + + // Category Covers + Log.BenchmarkStart(1); + Log.LogStatus('Creating Category Covers Array', 'Initialization'); + CatCovers:= TCatCovers.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Category Covers Array', 1); + + // Songs + //Log.BenchmarkStart(1); + Log.LogStatus('Creating Song Array', 'Initialization'); + Songs := TSongs.Create; + Songs.LoadSongList; + Log.LogStatus('Creating 2nd Song Array', 'Initialization'); + CatSongs := TCatSongs.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Songs', 1); + + // PluginManager + Log.BenchmarkStart(1); + Log.LogStatus('PluginManager', 'Initialization'); + DLLMan := TDLLMan.Create; //Load PluginList + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PluginManager', 1); + + // Party Mode Manager + Log.BenchmarkStart(1); + Log.LogStatus('PartySession Manager', 'Initialization'); + PartySession := TParty_Session.Create; //Load PartySession + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PartySession Manager', 1); + + // Sound + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + +// exit; + + // Graphics + Log.BenchmarkStart(1); + Log.LogStatus('Initialize 3D', 'Initialization'); + Initialize3D(WndTitle); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing 3D', 1); + + // Score Saving System + Log.BenchmarkStart(1); + Log.LogStatus('DataBase System', 'Initialization'); + DataBase := TDataBaseSystem.Create; + + if (Params.ScoreFile = '') then + DataBase.Init ('Ultrastar.db') + else + DataBase.Init (Params.ScoreFile); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading DataBase System', 1); + + //Playlist Manager + Log.BenchmarkStart(1); + Log.LogStatus('Playlist Manager', 'Initialization'); + PlaylistMan := TPlaylistManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Playlist Manager', 1); + + //GoldenStarsTwinkleMod + Log.BenchmarkStart(1); + Log.LogStatus('Effect Manager', 'Initialization'); + GoldenRec := TEffectManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Particel System', 1); + + // Joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then begin + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Joystick', 'Initialization'); + Joy := TJoy.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Joystick', 1); + end; + + Log.BenchmarkEnd(0); + Log.LogBenchmark('Loading Time', 0); + + Log.LogError('Creating Core'); + Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0))); + + Log.LogError('Running Core'); + Core.Run; + + //------------------------------ + //Start- Mainloop + //------------------------------ + //Music.SetLoop(true); + //Music.SetVolume(50); + //Music.Open(SkinPath + 'Menu Music 3.mp3'); + //Music.Play; + Log.LogStatus('Main Loop', 'Initialization'); + MainLoop; + + //------------------------------ + //Finish Application + //------------------------------ + if Ini.LPT = 1 then LCD.Clear; + if Ini.LPT = 2 then Light.TurnOff; + + Log.LogStatus('Main Loop', 'Finished'); + + Log.Free; + +end; +{$ENDIF} procedure MainLoop; var diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index bf3ad727..37e311af 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -12,10 +12,7 @@ unit UMedia_dummy; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} implementation diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas index 493fc393..fe623343 100644 --- a/Game/Code/Classes/UModules.pas +++ b/Game/Code/Classes/UModules.pas @@ -1,6 +1,9 @@ unit UModules; interface + +{$I switches.inc} + {********************* UModules Unit Contains all used Modules in its uses clausel diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index f3342625..e2d2cc60 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -4,10 +4,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - uses Classes ; type diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 9be0df3e..4f351dc5 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -2,10 +2,7 @@ unit UParty; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} uses ModiSDK; diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 3f89ffed..b18d4833 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -2,10 +2,8 @@ unit UPlaylist; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} + type TPlaylistItem = record diff --git a/Game/Code/Classes/UPliki.pas b/Game/Code/Classes/UPliki.pas index f7692990..f4e8ff97 100644 --- a/Game/Code/Classes/UPliki.pas +++ b/Game/Code/Classes/UPliki.pas @@ -2,6 +2,8 @@ unit UPliki; interface +{$I switches.inc} + uses USongs, SysUtils, ULog, UMusic; procedure InitializePaths; diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas index a9cc7e46..56293848 100644 --- a/Game/Code/Classes/UPluginInterface.pas +++ b/Game/Code/Classes/UPluginInterface.pas @@ -6,6 +6,9 @@ unit uPluginInterface; *********************} interface + +{$I switches.inc} + uses uPluginDefs; //--------------- diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index b553504d..8d3fa5f7 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -4,10 +4,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - uses Classes, Math, SysUtils, diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index 0028576b..92b61e85 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -1,6 +1,9 @@ unit UServices; interface + +{$I switches.inc} + uses uPluginDefs, SysUtils; {********************* TServiceManager @@ -8,12 +11,6 @@ uses uPluginDefs, SysUtils; Saves all Services and their Procs *********************} -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - type TServiceName = String[60]; PServiceInfo = ^TServiceInfo; @@ -221,7 +218,7 @@ begin //Backup CurExecuted CurExecutedBackup := Core.CurExecuted; - Service := ptr(SExists); + Service := Pointer(SExists); If (Service.isClass) then //Use Proc of Class diff --git a/Game/Code/Classes/USingNotes.pas b/Game/Code/Classes/USingNotes.pas index e2162bf1..f0754105 100644 --- a/Game/Code/Classes/USingNotes.pas +++ b/Game/Code/Classes/USingNotes.pas @@ -1,6 +1,9 @@ unit USingNotes; interface + +{$I switches.inc} + { Dummy Unit atm For further expantation Placeholder for Class that will handle the Notes Drawing} diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 11f1f07d..d5256dc9 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -2,9 +2,7 @@ unit USingScores; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses UThemes, OpenGl12, @@ -425,7 +423,7 @@ begin // TODO : JB_Lazarus - Exception=Invalid floating point operation // AT THIS LINE ! - {$IFDEF FPC} + {$IFDEF LAZARUS} (* writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); @@ -438,7 +436,7 @@ begin lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); - {$IFDEF FPC} + {$IFDEF LAZARUS} (* writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index c9d7f2fd..5bab885b 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -1,12 +1,9 @@ unit USkins; -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - interface +{$I switches.inc} + type TSkinTexture = record Name: string; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 5ce35201..9e0d6ca5 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -2,14 +2,15 @@ unit USongs; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - +{$I switches.inc} uses SysUtils, - {$ifndef win32} - oldlinux, + {$ifndef MSWINDOWS} + {$IFDEF DARWIN} + baseunix, + {$ELSE} + oldlinux, + {$ENDIF} {$endif} ULog, UTexture, @@ -115,6 +116,12 @@ uses StrUtils, UMain, UIni; +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} procedure TSongs.LoadSongList; begin @@ -136,7 +143,7 @@ procedure TSongs.BrowseDir(Dir: widestring); var SLen: integer; - {$ifdef win32} + {$ifdef MSWINDOWS} SR: TSearchRecW; // for parsing Songs Directory {$else} // This should work on all posix systems. TheDir : pdir; @@ -145,7 +152,7 @@ var info : stat; {$endif} begin - {$ifdef win32} + {$ifdef MSWINDOWS} if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows begin repeat @@ -186,8 +193,9 @@ begin until FindNextW(SR) <> 0; end; // if FindFirst FindCloseW(SR); - - {$else} + {$ENDIF} + + {$IFDEF LINUX} // Itterate the Songs Directory... ( With unicode capable functions for linux ) TheDir := opendir( Dir ); // JB_Unicode - linux if TheDir <> nil then @@ -245,6 +253,66 @@ begin Until ADirent=Nil; end; // if FindFirst + {$endif} + + {$IFDEF DARWIN} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( d_name[0] <> '.') then + BrowseDir( Dir + d_name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + + + + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.d_name ) > -1 ) then + begin + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.d_name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; + + Until ADirent=Nil; + end; // if FindFirst {$endif} diff --git a/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas index 5a0655e5..a09456b8 100644 --- a/Game/Code/Classes/UTextClasses.pas +++ b/Game/Code/Classes/UTextClasses.pas @@ -1,6 +1,9 @@ unit UTextClasses; interface + +{$I switches.inc} + uses OpenGL12, SDL, UTexture, diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 5ef29316..76d78f5b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -19,10 +19,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - uses OpenGL12, {$IFDEF win32} windows, @@ -131,7 +127,7 @@ implementation uses ULog, DateUtils, UCovers, - {$IFDEF FPC} + {$IFDEF LAZARUS} LResources, {$ENDIF} StrUtils, dialogs; @@ -247,7 +243,7 @@ var TexRWops: PSDL_RWops; dHandle: THandle; - {$IFDEF FPC} + {$IFDEF LAZARUS} lLazRes : TLResource; lResData : TStringStream; {$ELSE} @@ -277,7 +273,7 @@ begin Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); // load from resource stream - {$IFNDEF FPC} + {$IFDEF WIN32} dHandle := FindResource(hInstance, Identifier, 'TEX'); if dHandle=0 then begin @@ -1134,7 +1130,7 @@ begin end; end; -{$IFDEF FPC} +{$IFDEF LAZARUS} initialization {$I UltraStar.lrs} {$ENDIF} diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 00b763f0..c27f9c9e 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -2,9 +2,7 @@ unit UThemes; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} +{$I switches.inc} uses ULog, diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index 87d17ee5..f714fed5 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -2,9 +2,7 @@ unit UTime; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} {$UNDEF DebugDisplay} diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 154cd04c..c18eea6c 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -20,9 +20,7 @@ unit UVideo; interface -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} +{$I switches.inc} (* diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 442e76e0..55c89878 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -1,793 +1,797 @@ -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 -uses UPluginDefs, UCoreModule; -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -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; - Procedure Free; 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, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 win32} - PluginFileExtension = '.dll'; - {$ELSE} - PluginFileExtension = '.so'; - {$ENDIF} - -implementation -uses UCore, UPluginInterface, -{$IFDEF win32} +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 + +{$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; + Procedure Free; 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, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 - //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.')), Integer(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 -//------------- -Procedure TPluginLoader.Free; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Plugins, 0); -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)), Integer(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)), Integer(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: ' + Info.Name)), Integer(PChar('TPluginLoader'))); - - //Unload Old Plugin - UnloadPlugin(Integer(nil), PluginID); - - //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)), Integer(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: ' + Info.Name)), Integer(PChar('TPluginLoader'))); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); - end; - end - else - Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(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: ' + Plugins[Index].Info.Name)), Integer(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: ' + Plugins[Index].Info.Name)), Integer(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) | lParam (if wParam = nil) ID of the Plugin -//-------------- -Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; -var - Index: Integer; - sFile: String; -begin - Result := -1; - sFile := ''; - //lParam is ID - If (Ptr(wParam) = nil) then - begin - Index := lParam; - end - else - begin //wParam is PChar - try - sFile := String(PChar(Ptr(wParam))); - 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) | lParam (if wParam = nil) ID of the Plugin -//-------------- -Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; -var - Index: Integer; - sName: String; -begin - Result := -1; - //lParam is ID - If (Ptr(wParam) = nil) then - begin - Index := lParam; - end - else - begin //wParam is PChar - try - sName := String(PChar(Ptr(wParam))); - 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, lParam: DWord): integer; -var I: Integer; -begin - Result := 0; - If (wParam < 0) then - begin //Get Info of 1 Plugin - If (Ptr(lParam) <> nil) AND (wParam < Length(Plugins)) then - begin - Try - Result := 1; - PUS_PluginInfo(Ptr(lParam))^ := Plugins[wParam].Info; - Except - - End; - end; - end - Else If (Ptr(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(Ptr(lParam))^[I] := Plugins[I].Info; - Result := Length(Plugins); - Except - Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Ptr(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(Ptr(lParam + I)^) := Plugins[I].State; - Result := Length(Plugins); - Except - Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(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 - 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 -label Continue; -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')), Integer(PChar('TtehPlugins'))); - end - else - begin - Result := True; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - I := 0; - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - Core.CurExecuted := -1 - I; - - //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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); - end - else - Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); - - Inc(I); - 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 + '"')), Integer(PChar('TtehPlugins'))); - - - //don't forget to increase I - Inc(I); - end; - End; - - If (I <= High(PluginLoader.Plugins)) then - Goto Continue; - - //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 -label Continue; -begin - Result := True; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - I := 0; - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - 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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); - end - else - Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); - - //don't forget to increase I - Inc(I); - end; - 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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); - - //don't forget to increase I - Inc(I); - End; - - If (I <= High(PluginLoader.Plugins)) then - GoTo Continue; - - //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 -label Continue; -begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loop - I := 0; - - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - //DeInit Plugin - PluginLoader.CallDeInit(I); - - Inc(I); - end; - Except - Inc(I); - End; - - If I <= High(PluginLoader.Plugins) then - Goto Continue; - - //Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -end. +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 + //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.')), Integer(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 +//------------- +Procedure TPluginLoader.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); +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)), Integer(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)), Integer(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))), Integer(PChar('TPluginLoader'))); + + //Unload Old Plugin + UnloadPlugin(Integer(nil), PluginID); + + //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)), Integer(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))), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(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))), Integer(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))), Integer(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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + If (Pointer(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sFile := String(PChar(Pointer(wParam))); + 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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sName: String; +begin + Result := -1; + //lParam is ID + If (Pointer(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(Pointer(wParam))); + 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, lParam: DWord): integer; +var I: Integer; +begin + Result := 0; + If (wParam < 0) then + begin //Get Info of 1 Plugin + If (Pointer(lParam) <> nil) AND (wParam < Length(Plugins)) then + begin + Try + Result := 1; + PUS_PluginInfo(Pointer(lParam))^ := Plugins[wParam].Info; + Except + + End; + end; + end + Else If (Pointer(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(Pointer(lParam))^[I] := Plugins[I].Info; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Pointer(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(lParam + I)^) := Plugins[I].State; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(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 + 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 +label Continue; +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')), Integer(PChar('TtehPlugins'))); + end + else + begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + Core.CurExecuted := -1 - I; + + //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))), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); + + Inc(I); + 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 + '"')), Integer(PChar('TtehPlugins'))); + + + //don't forget to increase I + Inc(I); + end; + End; + + If (I <= High(PluginLoader.Plugins)) then + Goto Continue; + + //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 +label Continue; +begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + 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))), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + end; + 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))), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + End; + + If (I <= High(PluginLoader.Plugins)) then + GoTo Continue; + + //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 +label Continue; +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + I := 0; + + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + //DeInit Plugin + PluginLoader.CallDeInit(I); + + Inc(I); + end; + Except + Inc(I); + End; + + If I <= High(PluginLoader.Plugins) then + Goto Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. -- cgit v1.2.3 From 4df428bedccc51a542f46f3737a5848265d6dc27 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 1 Nov 2007 19:50:02 +0000 Subject: Windows version now compiles again. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@547 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index bbc64f80..80305b35 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -5,6 +5,9 @@ interface {$I switches.inc} uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF} SDL, UGraphic, UMusic, @@ -131,7 +134,7 @@ procedure ClearScores(PlayerNum: integer); implementation -uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, +uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, UParty, UCore, UGraphicClasses, UPluginDefs; -- cgit v1.2.3 From 99955c78f63d1cb0d8bec666bc33953590a74c8a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 1 Nov 2007 23:22:01 +0000 Subject: fixed failed builds build:USDX-LAZLIN-75 build:USDX-LAZLIN-76 for some reason we can not use {$MODE Delphi} in an included file. ( Probably because of the way the compier scopes this switch to each pas file ) ive had to revert this part of eddies changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@548 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 4 + Game/Code/Classes/UAudio_FFMpeg.pas | 77 +- Game/Code/Classes/UAudio_bass.pas | 4 + Game/Code/Classes/UCommon.pas | 4 + Game/Code/Classes/UCore.pas | 21 +- Game/Code/Classes/UCoreModule.pas | 248 +++-- Game/Code/Classes/UCovers.pas | 526 ++++----- Game/Code/Classes/UDLLManager.pas | 4 + Game/Code/Classes/UDataBase.pas | 4 + Game/Code/Classes/UDraw.pas | 4 + Game/Code/Classes/UFiles.pas | 6 + Game/Code/Classes/UGraphic.pas | 4 + Game/Code/Classes/UGraphicClasses.pas | 4 + Game/Code/Classes/UHooks.pas | 855 +++++++------- Game/Code/Classes/UIni.pas | 4 + Game/Code/Classes/ULanguage.pas | 4 + Game/Code/Classes/ULight.pas | 4 + Game/Code/Classes/ULog.pas | 4 + Game/Code/Classes/ULyrics.pas | 4 + Game/Code/Classes/ULyrics_bak.pas | 852 +++++++------- Game/Code/Classes/UMain.pas | 8 +- Game/Code/Classes/UMedia_dummy.pas | 4 + Game/Code/Classes/UMusic.pas | 4 + Game/Code/Classes/UParty.pas | 757 ++++++------- Game/Code/Classes/UPlaylist.pas | 930 ++++++++-------- Game/Code/Classes/URecord.pas | 4 + Game/Code/Classes/UServices.pas | 647 +++++------ Game/Code/Classes/USingScores.pas | 1976 +++++++++++++++++---------------- Game/Code/Classes/USkins.pas | 4 + Game/Code/Classes/USongs.pas | 9 +- Game/Code/Classes/UTexture.pas | 4 + Game/Code/Classes/UThemes.pas | 4 + Game/Code/Classes/UTime.pas | 3 + Game/Code/Classes/UVideo.pas | 7 +- Game/Code/Classes/uPluginLoader.pas | 4 + 35 files changed, 3579 insertions(+), 3423 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index af60c4ff..aaee50a0 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -2,6 +2,10 @@ unit TextGL; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 675dfd3c..afbb23c1 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -13,6 +13,10 @@ This unit is primarily based upon - interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} @@ -59,7 +63,7 @@ var // audio_buf : array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} type - Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; + Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE-1 ] of byte; PAudioBuff = ^Taudiobuff; implementation @@ -376,6 +380,9 @@ end; procedure TAudio_ffMpeg.PlayStart; begin + + // LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); + // TODO : jb_linux replace with something other than bass // BASS_ChannelPlay(BassStart, True); end; @@ -458,10 +465,13 @@ var len1 , data_size : integer; begin + result := -1; + +(* {$ifdef win32} - FillChar(pkt, sizeof(pkt), #0); + FillChar(pkt, sizeof(TAVPacket), #0); {$else} - memset(@pkt, 0, sizeof(pkt)); // todo : jb memset + memset(@pkt, 0, sizeof(TAVPacket)); // todo : jb memset {$endif} audio_pkt_data := nil; @@ -469,7 +479,7 @@ begin while true do begin - + while ( audio_pkt_size > 0 ) do begin // writeln( 'got audio packet' ); @@ -479,22 +489,15 @@ begin if aAudio_buf <> nil then begin -// writeln( 'pre avcodec_decode_audio' ); - {$ifdef fpc} - len1 := avcodec_decode_audio(@aCodecCtx, PWord( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. - {$else} - len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. - {$endif} -// writeln( 'post avcodec_decode_audio' ); - + len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. end; -// writeln('avcodec_decode_audio'); +// writeln('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin //* if error, skip frame */ -// writeln( 'Skip audio frame' ); + writeln( 'Skip audio frame' ); audio_pkt_size := 0; break; end; @@ -532,7 +535,7 @@ begin audio_pkt_data := pchar( pkt.data ); audio_pkt_size := pkt.size; // writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; + end; *) end; procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); @@ -558,41 +561,45 @@ begin while (len > 0) do begin - if(audio_buf_index >= audio_buf_size) then + + if (audio_buf_index >= audio_buf_size) then begin + // We have already sent all our data; get more */ - audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(laudio_buf)); + audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(Taudiobuff)); + writeln( 'audio_decode_frame : ' + inttostr( audio_size ) + ' / ' + inttostr( sizeof(Taudiobuff) ) ); - if(audio_size < 0) then + if(audio_size > 0) then begin - // If error, output silence */ - audio_buf_size := 1024; // arbitrary? - - {$ifdef win32} - FillChar(laudio_buf, audio_buf_size, #0); - {$else} - memset(laudio_buf, 0, audio_buf_size); // todo : jb memset - {$endif} + audio_buf_size := audio_size; end else begin - audio_buf_size := audio_size; + // If error, output silence */ + +// audio_buf_size := 1024; // arbitrary? + +// {$ifdef win32} +// FillChar(laudio_buf, audio_buf_size, #0); +// {$else} +// memset(laudio_buf, 0, audio_buf_size); // todo : jb memset +// {$endif} + + writeln( 'Silence' ); end; audio_buf_index := 0; // Todo : jb - SegFault ? end; - - len1 := audio_buf_size - audio_buf_index; + len1 := audio_buf_size - audio_buf_index; if (len1 > len) then len1 := len; - + lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); {$ifdef WIN32} - lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); CopyMemory(stream, lSrc , len1); {$else} - memcpy(stream, PUInt8( laudio_buf ) + audio_buf_index , len1); + memcpy(stream, lSrc , len1); {$endif} len := len - len1; @@ -620,7 +627,7 @@ begin if FileExists(Name) then begin -// writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); // Open video file if (av_open_input_file(pFormatCtx, pchar(Name), nil, 0, nil) > 0) then @@ -697,6 +704,7 @@ begin // Free the packet that was allocated by av_read_frame SDL_PollEvent(@event); + (* if event.type_ = SDL_QUIT the begin @@ -706,8 +714,9 @@ begin else break; *) - end; + + writeln( 'Done filling buffer' ); // halt(0); diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 463a6c7f..9ef3b789 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -2,6 +2,10 @@ unit UAudio_bass; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b532f775..43017aff 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -2,6 +2,10 @@ unit UCommon; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 091868f2..acd9ead7 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -2,9 +2,17 @@ unit UCore; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} -uses uPluginDefs, uCoreModule, UHooks, UServices, UModules; +uses uPluginDefs, + uCoreModule, + UHooks, + UServices, + UModules; {********************* TCore Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process @@ -103,10 +111,11 @@ var Core: TCore; implementation -uses SysUtils, -{$IFDEF win32} -Windows -{$ENDIF}; + +uses {$IFDEF win32} + Windows, + {$ENDIF} + SysUtils; //------------- // Create - Creates Class + Hook and Service Manager @@ -489,4 +498,4 @@ begin Result := hInstance; end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index b135089c..c8c54161 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -1,122 +1,126 @@ -unit UCoreModule; - -interface - -{$I switches.inc} - -{********************* - TCoreModule - Dummy Class that has Methods that will be called from Core - In the Best case every Piece of this Software is a Module -*********************} -uses UPluginDefs; - -type - PCoreModule = ^TCoreModule; - TCoreModule = class - public - Constructor Create; virtual; - - //Function that gives some Infos about the Module to the Core - Procedure Info(const pInfo: PModuleInfo); virtual; - - //Is Called on Loading. - //In this Method only Events and Services should be created - //to offer them to other Modules or Plugins during the Init process - //If False is Returned this will cause a Forced Exit - Function Load: Boolean; virtual; - - //Is Called on Init Process - //In this Method you can Hook some Events and Create + Init - //your Classes, Variables etc. - //If False is Returned this will cause a Forced Exit - Function Init: Boolean; virtual; - - //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing - //If False is Returned this will cause a Forced Exit - Function MainLoop: Boolean; virtual; - - //Is Called if this Module has been Inited and there is a Exit. - //Deinit is in backwards Initing Order - //If False is Returned this will cause a Forced Exit - Procedure DeInit; virtual; - - //Is Called if this Module will be unloaded and has been created - //Should be used to Free Memory - Procedure Free; virtual; - end; - cCoreModule = class of TCoreModule; - -implementation - -//------------- -// Just the Constructor -//------------- -Constructor TCoreModule.Create; -begin - //Dummy maaaan ;) -end; - -//------------- -// Function that gives some Infos about the Module to the Core -//------------- -Procedure TCoreModule.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'Not Set'; - pInfo^.Version := 0; - pInfo^.Description := 'Not Set'; -end; - -//------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Load: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Init: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.MainLoop: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -Procedure TCoreModule.DeInit; -begin - //Dummy ftw!! -end; - -//------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory -//------------- -Procedure TCoreModule.Free; -begin - //Dummy ftw!! -end; - -end. \ No newline at end of file +unit UCoreModule; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{********************* + TCoreModule + Dummy Class that has Methods that will be called from Core + In the Best case every Piece of this Software is a Module +*********************} +uses UPluginDefs; + +type + PCoreModule = ^TCoreModule; + TCoreModule = class + public + Constructor Create; virtual; + + //Function that gives some Infos about the Module to the Core + Procedure Info(const pInfo: PModuleInfo); virtual; + + //Is Called on Loading. + //In this Method only Events and Services should be created + //to offer them to other Modules or Plugins during the Init process + //If False is Returned this will cause a Forced Exit + Function Load: Boolean; virtual; + + //Is Called on Init Process + //In this Method you can Hook some Events and Create + Init + //your Classes, Variables etc. + //If False is Returned this will cause a Forced Exit + Function Init: Boolean; virtual; + + //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing + //If False is Returned this will cause a Forced Exit + Function MainLoop: Boolean; virtual; + + //Is Called if this Module has been Inited and there is a Exit. + //Deinit is in backwards Initing Order + //If False is Returned this will cause a Forced Exit + Procedure DeInit; virtual; + + //Is Called if this Module will be unloaded and has been created + //Should be used to Free Memory + Procedure Free; virtual; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) +end; + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TCoreModule.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'Not Set'; + pInfo^.Version := 0; + pInfo^.Description := 'Not Set'; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Load: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Init: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.MainLoop: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TCoreModule.DeInit; +begin + //Dummy ftw!! +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Procedure TCoreModule.Free; +begin + //Dummy ftw!! +end; + +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index f4ede329..9cc2a5e9 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -1,261 +1,265 @@ -unit UCovers; - -interface - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - UThemes, - UTexture; - -type - TCover = record - Name: string; - W: word; - H: word; - Size: integer; - Position: integer; // position of picture in the cache file -// Data: array of byte; - end; - - TCovers = class - Cover: array of TCover; - W: word; - H: word; - Size: integer; - Data: array of byte; - WritetoFile: Boolean; - - constructor Create; - procedure Load; - procedure Save; - procedure AddCover(Name: string); - function CoverExists(Name: string): boolean; - function CoverNumber(Name: string): integer; - procedure PrepareData(Name: string); - end; - -var - Covers: TCovers; - -implementation - -uses UMain, - // UFiles, - ULog, - DateUtils; - -constructor TCovers.Create; -begin - W := 128; - H := 128; - Size := W*H*3; - Load; - WritetoFile := True; -end; - -procedure TCovers.Load; -var - F: File; - C: integer; // cover number - W: word; - H: word; - Bits: byte; - NLen: word; - Name: string; -// Data: array of byte; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); - - SetLength(Cover, 0); - - while not EOF(F) do - begin - SetLength(Cover, Length(Cover)+1); - - BlockRead(F, W, 2); - Cover[High(Cover)].W := W; - - BlockRead(F, H, 2); - Cover[High(Cover)].H := H; - - BlockRead(F, Bits, 1); - - Cover[High(Cover)].Size := W * H * (Bits div 8); - - // test - // W := 128; - // H := 128; - // Bits := 24; - // Seek(F, FilePos(F) + 3); - - BlockRead(F, NLen, 2); - SetLength(Name, NLen); - - BlockRead(F, Name[1], NLen); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].Position := FilePos(F); - Seek(F, FilePos(F) + W*H*(Bits div 8)); - - // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); - // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); - - end; // While - - CloseFile(F); - end; // fileexists -end; - -procedure TCovers.Save; -var - F: File; - C: integer; // cover number - W: word; - H: word; - NLen: word; - Bits: byte; -begin -{ AssignFile(F, GamePath + 'covers.cache'); - Rewrite(F, 1); - - Bits := 24; - for C := 0 to High(Cover) do begin - W := Cover[C].W; - H := Cover[C].H; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Cover[C].Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Cover[C].Name[1], NLen); - BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); - end; - - CloseFile(F);} -end; - -procedure TCovers.AddCover(Name: string); -var - B: integer; - F: File; - C: integer; // cover number - NLen: word; - Bits: byte; -begin - if not CoverExists(Name) then - begin - SetLength(Cover, Length(Cover)+1); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].W := W; - Cover[High(Cover)].H := H; - Cover[High(Cover)].Size := Size; - - // do not copy data. write them directly to file -// SetLength(Cover[High(Cover)].Data, Size); -// for B := 0 to Size-1 do -// Cover[High(Cover)].Data[B] := CacheMipmap[B]; - - if WritetoFile then - begin - AssignFile(F, GamePath + 'covers.cache'); - - if FileExists(GamePath + 'covers.cache') then - begin - Reset(F, 1); - Seek(F, FileSize(F)); - end - else - begin - Rewrite(F, 1); - end; - - Bits := 24; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Name[1], NLen); - - Cover[High(Cover)].Position := FilePos(F); - BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); - - CloseFile(F); - end; - end - else - Cover[High(Cover)].Position := 0; -end; - -function TCovers.CoverExists(Name: string): boolean; -var - C: integer; // cover -begin - Result := false; - C := 0; - - while (C <= High(Cover)) and (Result = false) do - begin - if Cover[C].Name = Name then - Result := true; - - Inc(C); - end; -end; - -function TCovers.CoverNumber(Name: string): integer; -var - C: integer; -begin - Result := -1; - C := 0; - - while (C <= High(Cover)) and (Result = -1) do - begin - if Cover[C].Name = Name then - Result := C; - - Inc(C); - end; -end; - -procedure TCovers.PrepareData(Name: string); -var - F: File; - C: integer; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - C := CoverNumber(Name); - SetLength(Data, Cover[C].Size); - if Length(Data) < 6 then beep; - Seek(F, Cover[C].Position); - BlockRead(F, Data[0], Cover[C].Size); - CloseFile(F); - end; -end; - -end. +unit UCovers; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation + +uses UMain, + // UFiles, + ULog, + DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; // While + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then + begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + + if FileExists(GamePath + 'covers.cache') then + begin + Reset(F, 1); + Seek(F, FileSize(F)); + end + else + begin + Rewrite(F, 1); + end; + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + + while (C <= High(Cover)) and (Result = false) do + begin + if Cover[C].Name = Name then + Result := true; + + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + + while (C <= High(Cover)) and (Result = -1) do + begin + if Cover[C].Name = Name then + Result := C; + + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 358be9af..cbe79c3c 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -2,6 +2,10 @@ unit UDLLManager; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses ModiSDK, diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index 0cafc9fd..e99cb891 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -2,6 +2,10 @@ unit UDataBase; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses USongs, diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 350926d8..efc3494b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -2,6 +2,10 @@ unit UDraw; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UThemes, diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 5f168ead..e4f83b7a 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -2,6 +2,9 @@ unit UFiles; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} {$I switches.inc} uses SysUtils, @@ -329,8 +332,11 @@ Result := False; //Reset LineNo FileLineNo := 0; + writeln( 'Assign File : ' + Song.Path + Song.FileName ); + //Open File and set File Pointer to the beginning AssignFile(SongFile, Song.Path + Song.FileName); + // if assinged( SongFile ) then begin try diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 26601f2d..bfad2d73 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -2,6 +2,10 @@ unit UGraphic; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 2acd5530..4dfc66ce 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -3,6 +3,10 @@ unit UGraphicClasses; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UTexture; diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index ea31ec50..c30803f7 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -1,425 +1,430 @@ -unit UHooks; - -{********************* - THookManager - Class for saving, managing and calling of Hooks. - Saves all hookable events and their subscribers -*********************} -interface - -{$I switches.inc} - -uses uPluginDefs, SysUtils; - -type - //Record that saves info from Subscriber - PSubscriberInfo = ^TSubscriberInfo; - TSubscriberInfo = record - Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) - Next: PSubscriberInfo; //Pointer to next Item in HookChain - - Owner: Integer; //For Error Handling and Plugin Unloading. - - //Here is s/t tricky - //To avoid writing of Wrapping Functions to Hook an Event with a Class - //We save a Normal Proc or a Method of a Class - Case isClass: boolean of - False: (Proc: TUS_Hook); //Proc that will be called on Event - True: (ProcOfClass: TUS_Hook_of_Object); - end; - - TEventInfo = record - Name: String[60]; //Name of Event - FirstSubscriber: PSubscriberInfo; //First subscriber in chain - LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding - end; - - THookManager = class - private - Events: array of TEventInfo; - SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) - - Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); - public - constructor Create(const SpacetoAllocate: Word); - - Function AddEvent (const EventName: PChar): THandle; - Function DelEvent (hEvent: THandle): Integer; - - Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; - Function DelSubscriber (const hSubscriber: THandle): Integer; - - Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; - Function EventExists (const EventName: PChar): Integer; - - Procedure DelbyOwner(const Owner: Integer); - end; - -function HookTest(wParam, lParam: DWord): integer; stdcall; - -var - HookManager: THookManager; - -implementation -uses UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -constructor THookManager.Create(const SpacetoAllocate: Word); -var I: Integer; -begin - //Get the Space and "Zero" it - SetLength (Events, SpacetoAllocate); - For I := 0 to SpacetoAllocate do - Events[I].Name[1] := chr(0); - - SpaceinEvents := SpacetoAllocate; - - {$IFDEF DEBUG} - WriteLn('HookManager: Succesful Created.'); - {$ENDIF} -end; - -//------------ -// AddEvent - Adds an Event and return the Events Handle or 0 on Failure -//------------ -Function THookManager.AddEvent (const EventName: PChar): THandle; -var I: Integer; -begin - Result := 0; - - if (EventExists(EventName) = 0) then - begin - If (SpaceinEvents > 0) then - begin - //There is already Space available - //Go Search it! - For I := 0 to High(Events) do - If (Events[I].Name[1] = chr(0)) then - begin //Found Space - Result := I; - Dec(SpaceinEvents); - Break; - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); - {$ENDIF} - end - else - begin //There is no Space => Go make some! - Result := Length(Events); - SetLength(Events, Result + 1); - end; - - //Set Events Data - Events[Result].Name := EventName; - Events[Result].FirstSubscriber := nil; - Events[Result].LastSubscriber := nil; - - //Handle is Index + 1 - Inc(Result); - - {$IFDEF DEBUG} - WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); - {$ENDIF} - end - {$IFDEF DEBUG} - else - WriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); - {$ENDIF} -end; - -//------------ -// DelEvent - Deletes an Event by Handle Returns False on Failure -//------------ -Function THookManager.DelEvent (hEvent: THandle): Integer; -var - Cur, Last: PSubscriberInfo; -begin - hEvent := hEvent - 1; //Arrayindex is Handle - 1 - Result := -1; - - - If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then - begin //Event exists - //Free the Space for all Subscribers - Cur := Events[hEvent].FirstSubscriber; - - While (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TSubscriberInfo)); - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); - {$ENDIF} - - //Free the Event - Events[hEvent].Name[1] := chr(0); - Inc(SpaceinEvents); //There is one more space for new events - end - - {$IFDEF DEBUG} - else - WriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); - {$ENDIF} -end; - -//------------ -// AddSubscriber - Adds an Subscriber to the Event by Name -// Returns Handle of the Subscribtion or 0 on Failure -//------------ -Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; -var - EventHandle: THandle; - EventIndex: Cardinal; - Cur: PSubscriberInfo; -begin - Result := 0; - - If (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - EventHandle := EventExists(EventName); - - If (EventHandle <> 0) then - begin - EventIndex := EventHandle - 1; - - //Get Memory - GetMem(Cur, SizeOf(TSubscriberInfo)); - - //Fill it with Data - Cur.Next := nil; - - //Add Owner - Cur.Owner := Core.CurExecuted; - - If (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := True; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := False; - Cur.Proc := Proc; - end; - - //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID - If (Events[EventIndex].LastSubscriber = nil) then - begin - If (Events[EventIndex].FirstSubscriber = nil) then - begin - Result := (EventHandle SHL 16); - Events[EventIndex].FirstSubscriber := Cur; - end - Else - begin - Result := Events[EventIndex].FirstSubscriber.Self + 1; - end; - end - Else - begin - Result := Events[EventIndex].LastSubscriber.Self + 1; - Events[EventIndex].LastSubscriber.Next := Cur; - end; - - Cur.Self := Result; - - //Add to Chain - Events[EventIndex].LastSubscriber := Cur; - - {$IFDEF DEBUG} - WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); - {$ENDIF} - end; - end; -end; - -//------------ -// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. -//------------ -Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); -begin - //Delete from Chain - If (Last <> nil) then - begin - Last.Next := Cur.Next; - end - else //Was first Popup - begin - Events[EventIndex].FirstSubscriber := Cur.Next; - end; - - //Was this Last subscription ? - If (Cur = Events[EventIndex].LastSubscriber) then - begin //Change Last Subscriber - Events[EventIndex].LastSubscriber := Last; - end; - - //Free Space: - FreeMem(Cur, SizeOf(TSubscriberInfo)); -end; - -//------------ -// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure -//------------ -Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; -var - EventIndex: Cardinal; - Cur, Last: PSubscriberInfo; -begin - Result := -1; - EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; - - //Existing Event ? - If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then - begin - Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription - - //Search for Subscription - Cur := Events[EventIndex].FirstSubscriber; - Last := nil; - - //go through the chain ... - While (Cur <> nil) do - begin - If (Cur.Self = hSubscriber) then - begin //Found Subscription we searched for - FreeSubscriber(EventIndex, Last, Cur); - - {$IFDEF DEBUG} - WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); - {$ENDIF} - - //Set Result and Break the Loop - Result := 0; - Break; - end; - - Last := Cur; - Cur := Cur.Next; - end; - - end; -end; - - -//------------ -// CallEventChain - Calls the Chain of a specified EventHandle -// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End -//------------ -Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; -var - EventIndex: Cardinal; - Cur: PSubscriberInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute -begin - Result := -1; - EventIndex := hEvent - 1; - - If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then - begin //Existing Event - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start calling the Chain !!!11 - Cur := Events[EventIndex].FirstSubscriber; - Result := 0; - //Call Hooks until the Chain is at the End or breaked - While ((Cur <> nil) AND (Result = 0)) do - begin - //Set CurExecuted - Core.CurExecuted := Cur.Owner; - if (Cur.isClass) then - Result := Cur.ProcOfClass(wParam, lParam) - else - Result := Cur.Proc(wParam, lParam); - - Cur := Cur.Next; - end; - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); - {$ENDIF} -end; - -//------------ -// EventExists - Returns non Zero if an Event with the given Name exists -//------------ -Function THookManager.EventExists (const EventName: PChar): Integer; -var - I: Integer; - Name: String[60]; -begin - Result := 0; - //If (Length(EventName) < - Name := String(EventName); - - //Sure not to search for empty space - If (Name[1] <> chr(0)) then - begin - //Search for Event - For I := 0 to High(Events) do - If (Events[I].Name = Name) then - begin //Event found - Result := I + 1; - Break; - end; - end; -end; - -//------------ -// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) -//------------ -Procedure THookManager.DelbyOwner(const Owner: Integer); -var - I: Integer; - Cur, Last: PSubscriberInfo; -begin - //Search for Owner in all Hooks Chains - For I := 0 to High(Events) do - begin - If (Events[I].Name[1] <> chr(0)) then - begin - - Last := nil; - Cur := Events[I].FirstSubscriber; - //Went Through Chain - While (Cur <> nil) do - begin - If (Cur.Owner = Owner) then - begin //Found Subscription by Owner -> Delete - FreeSubscriber(I, Last, Cur); - If (Last <> nil) then - Cur := Last.Next - else - Cur := Events[I].FirstSubscriber; - end - Else - begin - //Next Item: - Last := Cur; - Cur := Cur.Next; - end; - end; - end; - end; -end; - - -function HookTest(wParam, lParam: DWord): integer; stdcall; -begin - Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); -end; - -end. +unit UHooks; + +{********************* + THookManager + Class for saving, managing and calling of Hooks. + Saves all hookable events and their subscribers +*********************} +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; + +type + //Record that saves info from Subscriber + PSubscriberInfo = ^TSubscriberInfo; + TSubscriberInfo = record + Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) + Next: PSubscriberInfo; //Pointer to next Item in HookChain + + Owner: Integer; //For Error Handling and Plugin Unloading. + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to Hook an Event with a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Hook); //Proc that will be called on Event + True: (ProcOfClass: TUS_Hook_of_Object); + end; + + TEventInfo = record + Name: String[60]; //Name of Event + FirstSubscriber: PSubscriberInfo; //First subscriber in chain + LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + end; + + THookManager = class + private + Events: array of TEventInfo; + SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); + public + constructor Create(const SpacetoAllocate: Word); + + Function AddEvent (const EventName: PChar): THandle; + Function DelEvent (hEvent: THandle): Integer; + + Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + Function DelSubscriber (const hSubscriber: THandle): Integer; + + Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; + Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); + end; + +function HookTest(wParam, lParam: DWord): integer; stdcall; + +var + HookManager: THookManager; + +implementation +uses UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + For I := 0 to SpacetoAllocate do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + WriteLn('HookManager: Succesful Created.'); + {$ENDIF} +end; + +//------------ +// AddEvent - Adds an Event and return the Events Handle or 0 on Failure +//------------ +Function THookManager.AddEvent (const EventName: PChar): THandle; +var I: Integer; +begin + Result := 0; + + if (EventExists(EventName) = 0) then + begin + If (SpaceinEvents > 0) then + begin + //There is already Space available + //Go Search it! + For I := 0 to High(Events) do + If (Events[I].Name[1] = chr(0)) then + begin //Found Space + Result := I; + Dec(SpaceinEvents); + Break; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); + {$ENDIF} + end + else + begin //There is no Space => Go make some! + Result := Length(Events); + SetLength(Events, Result + 1); + end; + + //Set Events Data + Events[Result].Name := EventName; + Events[Result].FirstSubscriber := nil; + Events[Result].LastSubscriber := nil; + + //Handle is Index + 1 + Inc(Result); + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + WriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); + {$ENDIF} +end; + +//------------ +// DelEvent - Deletes an Event by Handle Returns False on Failure +//------------ +Function THookManager.DelEvent (hEvent: THandle): Integer; +var + Cur, Last: PSubscriberInfo; +begin + hEvent := hEvent - 1; //Arrayindex is Handle - 1 + Result := -1; + + + If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then + begin //Event exists + //Free the Space for all Subscribers + Cur := Events[hEvent].FirstSubscriber; + + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TSubscriberInfo)); + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); + {$ENDIF} + + //Free the Event + Events[hEvent].Name[1] := chr(0); + Inc(SpaceinEvents); //There is one more space for new events + end + + {$IFDEF DEBUG} + else + WriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); + {$ENDIF} +end; + +//------------ +// AddSubscriber - Adds an Subscriber to the Event by Name +// Returns Handle of the Subscribtion or 0 on Failure +//------------ +Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +var + EventHandle: THandle; + EventIndex: Cardinal; + Cur: PSubscriberInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + EventHandle := EventExists(EventName); + + If (EventHandle <> 0) then + begin + EventIndex := EventHandle - 1; + + //Get Memory + GetMem(Cur, SizeOf(TSubscriberInfo)); + + //Fill it with Data + Cur.Next := nil; + + //Add Owner + Cur.Owner := Core.CurExecuted; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID + If (Events[EventIndex].LastSubscriber = nil) then + begin + If (Events[EventIndex].FirstSubscriber = nil) then + begin + Result := (EventHandle SHL 16); + Events[EventIndex].FirstSubscriber := Cur; + end + Else + begin + Result := Events[EventIndex].FirstSubscriber.Self + 1; + end; + end + Else + begin + Result := Events[EventIndex].LastSubscriber.Self + 1; + Events[EventIndex].LastSubscriber.Next := Cur; + end; + + Cur.Self := Result; + + //Add to Chain + Events[EventIndex].LastSubscriber := Cur; + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); + {$ENDIF} + end; + end; +end; + +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + +//------------ +// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure +//------------ +Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; +var + EventIndex: Cardinal; + Cur, Last: PSubscriberInfo; +begin + Result := -1; + EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; + + //Existing Event ? + If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then + begin + Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription + + //Search for Subscription + Cur := Events[EventIndex].FirstSubscriber; + Last := nil; + + //go through the chain ... + While (Cur <> nil) do + begin + If (Cur.Self = hSubscriber) then + begin //Found Subscription we searched for + FreeSubscriber(EventIndex, Last, Cur); + + {$IFDEF DEBUG} + WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); + {$ENDIF} + + //Set Result and Break the Loop + Result := 0; + Break; + end; + + Last := Cur; + Cur := Cur.Next; + end; + + end; +end; + + +//------------ +// CallEventChain - Calls the Chain of a specified EventHandle +// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End +//------------ +Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; +var + EventIndex: Cardinal; + Cur: PSubscriberInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := -1; + EventIndex := hEvent - 1; + + If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then + begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start calling the Chain !!!11 + Cur := Events[EventIndex].FirstSubscriber; + Result := 0; + //Call Hooks until the Chain is at the End or breaked + While ((Cur <> nil) AND (Result = 0)) do + begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; + if (Cur.isClass) then + Result := Cur.ProcOfClass(wParam, lParam) + else + Result := Cur.Proc(wParam, lParam); + + Cur := Cur.Next; + end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); + {$ENDIF} +end; + +//------------ +// EventExists - Returns non Zero if an Event with the given Name exists +//------------ +Function THookManager.EventExists (const EventName: PChar): Integer; +var + I: Integer; + Name: String[60]; +begin + Result := 0; + //If (Length(EventName) < + Name := String(EventName); + + //Sure not to search for empty space + If (Name[1] <> chr(0)) then + begin + //Search for Event + For I := 0 to High(Events) do + If (Events[I].Name = Name) then + begin //Event found + Result := I + 1; + Break; + end; + end; +end; + +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +Procedure THookManager.DelbyOwner(const Owner: Integer); +var + I: Integer; + Cur, Last: PSubscriberInfo; +begin + //Search for Owner in all Hooks Chains + For I := 0 to High(Events) do + begin + If (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + While (Cur <> nil) do + begin + If (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + If (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + Else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; +end; + + +function HookTest(wParam, lParam: DWord): integer; stdcall; +begin + Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); +end; + +end. diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 36ba2180..998a1d4b 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -2,6 +2,10 @@ unit UIni; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses IniFiles, ULog, SysUtils; diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index 25986263..dc07c298 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -2,6 +2,10 @@ unit ULanguage; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 6621cf59..b0ff9d6b 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -2,6 +2,10 @@ unit ULight; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} type diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 2ce70a11..7f0b82c4 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -2,6 +2,10 @@ unit ULog; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes; diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 96b9d43b..8eaa2a5f 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -2,6 +2,10 @@ unit ULyrics; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses OpenGL12, diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas index b5a9d798..703ee270 100644 --- a/Game/Code/Classes/ULyrics_bak.pas +++ b/Game/Code/Classes/ULyrics_bak.pas @@ -1,424 +1,428 @@ -unit ULyrics_bak; - -interface - -{$I switches.inc} - -uses SysUtils, - OpenGL12, - UMusic, - UTexture; - -type - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - Scale: real; - Done: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; - end; - - TLyric = class - private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - ScaleR: real; - StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left - FontStyleI: integer; // font number - Word: array of TWord; - - //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled - PlayerIconTex: array[0..5] of array [0..1] of TTexture; - - procedure SetX(Value: real); - procedure SetY(Value: real); - function GetClientX: real; - procedure SetAlign(Value: integer); - function GetSize: real; - procedure SetSize(Value: real); - procedure SetSelected(Value: integer); - procedure SetDone(Value: real); - procedure SetScale(Value: real); - procedure SetStyle(Value: integer); - procedure SetFStyle(Value: integer); - procedure Refresh; - - procedure DrawNormal(W: integer); - procedure DrawPlain(W: integer); - procedure DrawScaled(W: integer); - procedure DrawSlide(W: integer); - - procedure DrawPlayerIcons; - public - //Array containing Players Singing the Next Sentence - // 1: Player 1 Active - // 2: Player 2 Active - // 3: Player 3 Active - PlayersActive: Byte; - - //Dark or Light Colors - Enabled: Boolean; - - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - Text: string; // LCD - - constructor Create; - - procedure AddWord(Text: string); - procedure AddCzesc(NrCzesci: integer); - - function SelectedLetter: integer; // LCD - function SelectedLength: integer; // LCD - - procedure Clear; - procedure Draw; - published - property X: real write SetX; - property Y: real write SetY; - property ClientX: real read GetClientX; - property Align: integer write SetAlign; - property Size: real read GetSize write SetSize; - property Selected: integer read SelectedI write SetSelected; - property Done: real write SetDone; - property Scale: real write SetScale; - property Style: integer write SetStyle; - property FontStyle: integer write SetFStyle; - end; - -var - Lyric: TLyric; - -implementation -uses TextGL, UGraphic, UDrawTexture, Math, USkins; - -Constructor TLyric.Create; -var - I: Integer; -begin - //Only 2 Players for now - For I := 0 to 1 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - end; - PlayersActive := Trunc(Power(2, 1)) + 1; -end; - -procedure TLyric.SetX(Value: real); -begin - XR := Value; -end; - -procedure TLyric.SetY(Value: real); -begin - YR := Value; -end; - -function TLyric.GetClientX: real; -begin - Result := Word[0].X; -end; - -procedure TLyric.SetAlign(Value: integer); -begin - AlignI := Value; -// if AlignInt = 0 then beep; -end; - -function TLyric.GetSize: real; -begin - Result := SizeR; -end; - -procedure TLyric.SetSize(Value: real); -begin - SizeR := Value; -end; - -procedure TLyric.SetSelected(Value: integer); -var - W: integer; -begin - if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - Word[SelectedI].Selected := false; - Word[SelectedI].ColR := ColR; - Word[SelectedI].ColG := ColG; - Word[SelectedI].ColB := ColB; - Word[SelectedI].Done := 0; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - Word[Value].Selected := true; - Word[Value].ColR := ColSR; - Word[Value].ColG := ColSG; - Word[Value].ColB := ColSB; - Word[Value].Scale := ScaleR; - end; - end; - - if (StyleI = 1) or (StyleI = 3) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - for W := SelectedI to High(Word) do begin - Word[W].Selected := false; - Word[W].ColR := ColR; - Word[W].ColG := ColG; - Word[W].ColB := ColB; - Word[W].Done := 0; - end; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - for W := 0 to Value do begin - Word[W].Selected := true; - Word[W].ColR := ColSR; - Word[W].ColG := ColSG; - Word[W].ColB := ColSB; - Word[W].Scale := ScaleR; - Word[W].Done := 1; - end; - end; - end; - - Refresh; -end; - -procedure TLyric.SetDone(Value: real); -var - W: integer; -begin - W := SelectedI; - if W > -1 then - Word[W].Done := Value; -end; - -procedure TLyric.SetScale(Value: real); -begin - ScaleR := Value; -end; - -procedure TLyric.SetStyle(Value: integer); -begin - StyleI := Value; -end; - -procedure TLyric.SetFStyle(Value: integer); -begin - FontStyleI := Value; -end; - -procedure TLyric.AddWord(Text: string); -var - WordNum: integer; -begin - WordNum := Length(Word); - SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin - Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - end; - - Word[WordNum].Y := YR; - Word[WordNum].Size := SizeR; - Word[WordNum].FontStyle := FontStyleI; // new - SetFontStyle(FontStyleI); - SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(pchar(Text)); - Word[WordNum].Text := Text; - Word[WordNum].ColR := ColR; - Word[WordNum].ColG := ColG; - Word[WordNum].ColB := ColB; - Word[WordNum].Scale := 1; - Word[WordNum].Done := 0; - Word[WordNum].Italic := Italic; - - Refresh; -end; - -procedure TLyric.AddCzesc(NrCzesci: integer); -var - N: integer; -begin - Clear; - for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin - Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; - AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); - Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; - end; - Selected := -1; -end; - -procedure TLyric.Clear; -begin -{ ColR := Skin_FontR; - ColG := Skin_FontG; - ColB := Skin_FontB;} - SetLength(Word, 0); - Text := ''; - SelectedI := -1; -end; - -procedure TLyric.Refresh; -var - W: integer; - TotWidth: real; -begin - if AlignI = 1 then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; - - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; - end; -end; - -procedure TLyric.DrawPlayerIcons; -begin - -end; - -procedure TLyric.Draw; -var - W: integer; -begin - case StyleI of - 0: - begin - for W := 0 to High(Word) do - DrawNormal(W); - end; - 1: - begin - for W := 0 to High(Word) do - DrawPlain(W); - end; - 2: // zoom - begin - for W := 0 to High(Word) do - if not Word[W].Selected then - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then - DrawScaled(W); - end; - 3: // slide - begin - for W := 0 to High(Word) do begin - if not Word[W].Selected then - DrawNormal(W) - else - DrawSlide(W); - end; - end; - 4: // ball - begin - for W := 0 to High(Word) do - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then begin - Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; - Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); - Tex_Ball.W := 20; - Tex_Ball.H := 20; - DrawTexture(Tex_Ball); - end; - end; - end; // case -end; - -procedure TLyric.DrawNormal(W: integer); -begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawPlain(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - - if D = 0 then - glColor3f(ColR, ColG, ColB) - else - glColor3f(ColSR, ColSG, ColSB); - - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawScaled(W: integer); -var - D: real; -begin - // previous plus dynamic scaling effect - D := 1-Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); - SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)) -end; - -procedure TLyric.DrawSlide(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); -end; - -function TLyric.SelectedLetter; // LCD -var - W: integer; -begin - Result := 1; - - for W := 0 to SelectedI-1 do - Result := Result + Length(Word[W].Text); -end; - -function TLyric.SelectedLength: integer; // LCD -begin - Result := Length(Word[SelectedI].Text); -end; - -end. +unit ULyrics_bak; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses SysUtils, + OpenGL12, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + + //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + PlayerIconTex: array[0..5] of array [0..1] of TTexture; + + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + + procedure DrawPlayerIcons; + public + //Array containing Players Singing the Next Sentence + // 1: Player 1 Active + // 2: Player 2 Active + // 3: Player 3 Active + PlayersActive: Byte; + + //Dark or Light Colors + Enabled: Boolean; + + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + constructor Create; + + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture, Math, USkins; + +Constructor TLyric.Create; +var + I: Integer; +begin + //Only 2 Players for now + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + PlayersActive := Trunc(Power(2, 1)) + 1; +end; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + Word[SelectedI].Done := 0; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; // new + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TLyric.DrawPlayerIcons; +begin + +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 80305b35..d3b65e2f 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -2,6 +2,10 @@ unit UMain; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses @@ -141,7 +145,7 @@ uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, const Version = 'UltraStar Deluxe V 1.10 Alpha Build'; -{$IFDEF WIN32} +//{$IFDEF WIN32} Procedure Main; var WndTitle: string; @@ -401,7 +405,7 @@ begin Log.Free; end; -{$ENDIF} +//{$ENDIF} procedure MainLoop; var diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 37e311af..0c788677 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -12,6 +12,10 @@ unit UMedia_dummy; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} implementation diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index e2d2cc60..3fc1136b 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -2,6 +2,10 @@ unit UMusic; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes ; diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 4f351dc5..36a40858 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,376 +1,381 @@ -unit UParty; - -interface - -{$I switches.inc} - -uses ModiSDK; - -type - TRoundInfo = record - Plugin: Word; - Winner: Byte; - end; - - TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; - end; - - TeamOrderArray = Array[0..5] of Byte; - - TParty_Session = class - private - function GetRandomPlayer(Team: Byte): Byte; - function IsWinner(Player, Winner: Byte): boolean; - procedure GenScores; - public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: Byte; - - constructor Create; - - procedure StartNewParty(NumRounds: Byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: Byte): String; - end; - -var - PartySession: TParty_Session; - -implementation - -uses UDLLManager, UGraphic, UMain, ULanguage, ULog; - -//---------- -//Constructor - Prepares the Class -//---------- -constructor TParty_Session.Create; -begin -// - Nothing in here atm -end; - -//---------- -//StartNewParty - Clears the Class and Prepares for new Party -//---------- -procedure TParty_Session.StartNewParty(NumRounds: Byte); -var - Plugins: Array of record - ID: Byte; - TimesPlayed: Byte; - end; - TeamMode: Boolean; - Len: Integer; - I, J: Integer; - - function GetRandomPlugin: Byte; - var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; - begin - LowestTP := high(Byte); - NumPwithLTP := 0; - - //Search for Plugins not often played yet - For I := 0 to high(Plugins) do - begin - if (Plugins[I].TimesPlayed < lowestTP) then - begin - lowestTP := Plugins[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Plugins[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Plugin - For I := 0 to high(Plugins) do - begin - if Plugins[I].TimesPlayed = lowestTP then - begin - //Plugin Found - if (R = 0) then - begin - Result := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); - Break; - end; - - Dec(R); - end; - end; - end; -begin - //Set cur Round to Round 1 - CurRound := 255; - - PlayersPlay := Teams.NumTeams; - - //Get Teammode and Set Joker, also set TimesPlayed - TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - begin - if Teams.Teaminfo[I].NumPlayers < 2 then - begin - TeamMode := False; - end; - //Set Player Attributes - For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do - begin - Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; - end; - Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); - Teams.Teaminfo[I].Score := 0; - end; - - //Fill Plugin Array - SetLength(Plugins, 0); - For I := 0 to high(DLLMan.Plugins) do - begin - if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then - begin //Add only Plugins Playable with cur. PlayerConfiguration - Len := Length(Plugins); - SetLength(Plugins, Len + 1); - Plugins[Len].ID := I; - Plugins[Len].TimesPlayed := 0; - end; - end; - - //Set Rounds - If (Length(Plugins) >= 1) then - begin - SetLength (Rounds, NumRounds); - For I := 0 to NumRounds-1 do - begin - PartySession.Rounds[I].Plugin := GetRandomPlugin; - PartySession.Rounds[I].Winner := 255; - end; - end - else SetLength (Rounds, 0); -end; - -//---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round -//---------- -function TParty_Session.GetRandomPlayer(Team: Byte): Byte; -var - I, R: Integer; - lowestTP: Byte; - NumPwithLTP: Byte; -begin - LowestTP := high(Byte); - NumPwithLTP := 0; - Result := 0; - - //Search for Players that have not often played yet - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Player - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then - begin - //Player Found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); - end; - end; - {//Get lowest TimesPlayed - lowestTP := high(Byte); - J := -1; - for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - J := I; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - J := -1; - end; - end; - - //If more than one Person has lowestTP then Select Random Player - if (J < 0) then - repeat - Result := Random(Teams.Teaminfo[Team].NumPlayers); - until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) - else //Else Select the one with lowest TP - Result:= J;} -end; - -//---------- -//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin -//---------- -procedure TParty_Session.StartRound; -var - I: Integer; -begin - if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then - begin - //Increase Current Round - Inc (CurRound); - - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); - - //Select Players - for I := 0 to Teams.NumTeams-1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; - - //Set - end; -end; - -//---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte -//---------- -function TParty_Session.IsWinner(Player, Winner: Byte): boolean; -var - Bit: Byte; -begin - Case Player of - 0: Bit := 1; - 1: Bit := 2; - 2: Bit := 4; - 3: Bit := 8; - 4: Bit := 16; - 5: Bit := 32; - end; - - Result := ((Winner AND Bit) = Bit); -end; - -//---------- -//GenScores - Inc Scores for Cur. Round -//---------- -procedure TParty_Session.GenScores; -var - I: Byte; -begin - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); - end; -end; - -//---------- -//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , -//---------- -function TParty_Session.GetWinnerString(Round: Byte): String; -var - Winners: Array of String; - I: Integer; -begin - Result := Language.Translate('PARTY_NOBODY'); - - if (Round > High(Rounds)) then - exit; - - if (Rounds[Round].Winner = 0) then - begin - exit; - end; - - if (Rounds[Round].Winner = 255) then - begin - Result := Language.Translate('PARTY_NOTPLAYEDYET'); - exit; - end; - - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[Round].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - Result := Language.Implode(Winners); -end; - -//---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray -//---------- -procedure TParty_Session.EndRound; -var - I: Integer; -begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; - - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); - -end; - -//---------- -//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] -//---------- -function TParty_Session.GetTeamOrder: TeamOrderArray; -var - I, J: Integer; - ATeams: array [0..5] of TeamOrderEntry; - TempTeam: TeamOrderEntry; -begin - //Fill Team Array - For I := 0 to Teams.NumTeams-1 do - begin - ATeams[I].Teamnum := I; - ATeams[I].Score := Teams.Teaminfo[I].Score; - end; - - //Sort Teams - for J := 0 to Teams.NumTeams-1 do - for I := 1 to Teams.NumTeams-1 do - if ATeams[I].Score > ATeams[I-1].Score then - begin - TempTeam := ATeams[I-1]; - ATeams[I-1] := ATeams[I]; - ATeams[I] := TempTeam; - end; - - //Copy to Result - For I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; -end; - -end. +unit UParty; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +{$I switches.inc} + +uses ModiSDK; + +type + TRoundInfo = record + Plugin: Word; + Winner: Byte; + end; + + TeamOrderEntry = record + Teamnum: Byte; + Score: Byte; + end; + + TeamOrderArray = Array[0..5] of Byte; + + TParty_Session = class + private + function GetRandomPlayer(Team: Byte): Byte; + function IsWinner(Player, Winner: Byte): boolean; + procedure GenScores; + public + Teams: TTeamInfo; + Rounds: array of TRoundInfo; + CurRound: Byte; + + constructor Create; + + procedure StartNewParty(NumRounds: Byte); + procedure StartRound; + procedure EndRound; + function GetTeamOrder: TeamOrderArray; + function GetWinnerString(Round: Byte): String; + end; + +var + PartySession: TParty_Session; + +implementation + +uses UDLLManager, UGraphic, UMain, ULanguage, ULog; + +//---------- +//Constructor - Prepares the Class +//---------- +constructor TParty_Session.Create; +begin +// - Nothing in here atm +end; + +//---------- +//StartNewParty - Clears the Class and Prepares for new Party +//---------- +procedure TParty_Session.StartNewParty(NumRounds: Byte); +var + Plugins: Array of record + ID: Byte; + TimesPlayed: Byte; + end; + TeamMode: Boolean; + Len: Integer; + I, J: Integer; + + function GetRandomPlugin: Byte; + var + LowestTP: Byte; + NumPwithLTP: Word; + I: Integer; + R: Word; + begin + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Plugins not often played yet + For I := 0 to high(Plugins) do + begin + if (Plugins[I].TimesPlayed < lowestTP) then + begin + lowestTP := Plugins[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Plugins[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Plugin + For I := 0 to high(Plugins) do + begin + if Plugins[I].TimesPlayed = lowestTP then + begin + //Plugin Found + if (R = 0) then + begin + Result := Plugins[I].ID; + Inc(Plugins[I].TimesPlayed); + Break; + end; + + Dec(R); + end; + end; + end; +begin + //Set cur Round to Round 1 + CurRound := 255; + + PlayersPlay := Teams.NumTeams; + + //Get Teammode and Set Joker, also set TimesPlayed + TeamMode := True; + For I := 0 to Teams.NumTeams-1 do + begin + if Teams.Teaminfo[I].NumPlayers < 2 then + begin + TeamMode := False; + end; + //Set Player Attributes + For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do + begin + Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; + end; + Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + Teams.Teaminfo[I].Score := 0; + end; + + //Fill Plugin Array + SetLength(Plugins, 0); + For I := 0 to high(DLLMan.Plugins) do + begin + if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then + begin //Add only Plugins Playable with cur. PlayerConfiguration + Len := Length(Plugins); + SetLength(Plugins, Len + 1); + Plugins[Len].ID := I; + Plugins[Len].TimesPlayed := 0; + end; + end; + + //Set Rounds + If (Length(Plugins) >= 1) then + begin + SetLength (Rounds, NumRounds); + For I := 0 to NumRounds-1 do + begin + PartySession.Rounds[I].Plugin := GetRandomPlugin; + PartySession.Rounds[I].Winner := 255; + end; + end + else SetLength (Rounds, 0); +end; + +//---------- +//GetRandomPlayer - Gives back a Random Player to Play next Round +//---------- +function TParty_Session.GetRandomPlayer(Team: Byte): Byte; +var + I, R: Integer; + lowestTP: Byte; + NumPwithLTP: Byte; +begin + LowestTP := high(Byte); + NumPwithLTP := 0; + Result := 0; + + //Search for Players that have not often played yet + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Player + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + begin + //Player Found + if (R = 0) then + begin + Result := I; + Break; + end; + + Dec(R); + end; + end; + {//Get lowest TimesPlayed + lowestTP := high(Byte); + J := -1; + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + J := I; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + J := -1; + end; + end; + + //If more than one Person has lowestTP then Select Random Player + if (J < 0) then + repeat + Result := Random(Teams.Teaminfo[Team].NumPlayers); + until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) + else //Else Select the one with lowest TP + Result:= J;} +end; + +//---------- +//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin +//---------- +procedure TParty_Session.StartRound; +var + I: Integer; +begin + if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin + //Increase Current Round + Inc (CurRound); + + Rounds[CurRound].Winner := 255; + DllMan.LoadPlugin(Rounds[CurRound].Plugin); + + //Select Players + for I := 0 to Teams.NumTeams-1 do + Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + + //Set ScreenSingModie Variables + ScreenSingModi.TeamInfo := Teams; + + //Set + end; +end; + +//---------- +//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//---------- +function TParty_Session.IsWinner(Player, Winner: Byte): boolean; +var + Bit: Byte; +begin + Case Player of + 0: Bit := 1; + 1: Bit := 2; + 2: Bit := 4; + 3: Bit := 8; + 4: Bit := 16; + 5: Bit := 32; + end; + + Result := ((Winner AND Bit) = Bit); +end; + +//---------- +//GenScores - Inc Scores for Cur. Round +//---------- +procedure TParty_Session.GenScores; +var + I: Byte; +begin + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[CurRound].Winner) then + Inc(Teams.Teaminfo[I].Score); + end; +end; + +//---------- +//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , +//---------- +function TParty_Session.GetWinnerString(Round: Byte): String; +var + Winners: Array of String; + I: Integer; +begin + Result := Language.Translate('PARTY_NOBODY'); + + if (Round > High(Rounds)) then + exit; + + if (Rounds[Round].Winner = 0) then + begin + exit; + end; + + if (Rounds[Round].Winner = 255) then + begin + Result := Language.Translate('PARTY_NOTPLAYEDYET'); + exit; + end; + + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[Round].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; + end; + end; + Result := Language.Implode(Winners); +end; + +//---------- +//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray +//---------- +procedure TParty_Session.EndRound; +var + I: Integer; +begin + //Copy Winner + Rounds[CurRound].Winner := ScreenSingModi.Winner; + //Set Scores + GenScores; + + //Increase TimesPlayed 4 all Players + For I := 0 to Teams.NumTeams-1 do + Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); + +end; + +//---------- +//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] +//---------- +function TParty_Session.GetTeamOrder: TeamOrderArray; +var + I, J: Integer; + ATeams: array [0..5] of TeamOrderEntry; + TempTeam: TeamOrderEntry; +begin + //Fill Team Array + For I := 0 to Teams.NumTeams-1 do + begin + ATeams[I].Teamnum := I; + ATeams[I].Score := Teams.Teaminfo[I].Score; + end; + + //Sort Teams + for J := 0 to Teams.NumTeams-1 do + for I := 1 to Teams.NumTeams-1 do + if ATeams[I].Score > ATeams[I-1].Score then + begin + TempTeam := ATeams[I-1]; + ATeams[I-1] := ATeams[I]; + ATeams[I] := TempTeam; + end; + + //Copy to Result + For I := 0 to Teams.NumTeams-1 do + Result[I] := ATeams[I].TeamNum; +end; + +end. diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index b18d4833..8d981065 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -1,463 +1,467 @@ -unit UPlaylist; - -interface - -{$I switches.inc} - - -type - TPlaylistItem = record - Artist: String; - Title: String; - SongID: Integer; - end; - - APlaylistItem = array of TPlaylistItem; - - TPlaylist = record - Name: String; - Filename: String; - Items: APlaylistItem; - end; - - APlaylist = array of TPlaylist; - - //---------- - //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) - //---------- - TPlaylistManager = class - private - - public - Mode: Byte; //Current Playlist Mode for SongScreen - CurPlayList: Cardinal; - CurItem: Cardinal; - - Playlists: APlaylist; - - constructor Create; - Procedure LoadPlayLists; - Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; - Procedure SavePlayList(Index: Cardinal); - - Procedure SetPlayList(Index: Cardinal); - - Function AddPlaylist(Name: String): Cardinal; - Procedure DelPlaylist(const Index: Cardinal); - - Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); - Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); - - Procedure GetNames(var PLNames: array of String); - Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; - end; - - {Modes: - 0: Standard Mode - 1: Category Mode - 2: PlayList Mode} - - var - PlayListMan: TPlaylistManager; - - -implementation - -uses USongs, - ULog, - UMain, - //UFiles, - UGraphic, - UThemes, - SysUtils; - -//---------- -//Create - Construct Class - Dummy for now -//---------- -constructor TPlayListManager.Create; -begin - LoadPlayLists; -end; - -//---------- -//LoadPlayLists - Load list of Playlists from PlayList Folder -//---------- -Procedure TPlayListManager.LoadPlayLists; -var - SR: TSearchRec; - Len: Integer; -begin - SetLength(Playlists, 0); - - if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then - begin - repeat - Len := Length(Playlists); - SetLength(Playlists, Len +1); - - if not LoadPlayList (Len, Sr.Name) then - SetLength(Playlists, Len); - - until FindNext(SR) <> 0; - FindClose(SR); - end; -end; - -//---------- -//LoadPlayList - Load a Playlist in the Array -//---------- -Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; - var - F: TextFile; - Line: String; - PosDelimiter: Integer; - SongID: Integer; - Len: Integer; - - Function FindSong(Artist, Title: String): Integer; - var I: Integer; - begin - Result := -1; - - For I := low(CatSongs.Song) to high(CatSongs.Song) do - begin - if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then - begin - Result := I; - Break; - end; - end; - end; -begin - if not FileExists(PlayListPath + Filename) then - begin - Log.LogError('Could not load Playlist: ' + Filename); - Result := False; - Exit; - end; - Result := True; - - //Load File - AssignFile(F, PlayListPath + FileName); - Reset(F); - - //Set Filename - PlayLists[Index].Filename := Filename; - PlayLists[Index].Name := ''; - - //Read Until End of File - While not Eof(F) do - begin - //Read Curent Line - Readln(F, Line); - - if (Length(Line) > 0) then - begin - PosDelimiter := Pos(':', Line); - if (PosDelimiter <> 0) then - begin - //Comment or Name String - if (Line[1] = '#') then - begin - //Found Name Value - if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then - PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) - - end - //Song Entry - else - begin - SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); - if (SongID <> -1) then - begin - Len := Length(PlayLists[Index].Items); - SetLength(PlayLists[Index].Items, Len + 1); - - PlayLists[Index].Items[Len].SongID := SongID; - - PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); - PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); - end - else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); - end; - end; - end; - end; - - //If no special name is given, use Filename - if PlayLists[Index].Name = '' then - begin - PlayLists[Index].Name := ChangeFileExt(FileName, ''); - end; - - //Finish (Close File) - CloseFile(F); -end; - -//---------- -//SavePlayList - Saves the specified Playlist -//---------- -Procedure TPlayListManager.SavePlayList(Index: Cardinal); -var - F: TextFile; - I: Integer; -begin - if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then - begin - - //open File for Rewriting - AssignFile(F, PlaylistPath + Playlists[Index].Filename); - try - try - Rewrite(F); - - //Write Version (not nessecary but helpful) - WriteLn(F, '######################################'); - WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); - WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); - WriteLn(F, '######################################'); - - //Write Name Information - WriteLn(F, '#Name: ' + Playlists[Index].Name); - - //Write Song Information - WriteLn(F, '#Songs:'); - - For I := 0 to high(Playlists[Index].Items) do - begin - WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); - end; - except - log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); - end; - finally - CloseFile(F); - end; - end; -end; - -//---------- -//SetPlayList - Display a Playlist in CatSongs -//---------- -Procedure TPlayListManager.SetPlayList(Index: Cardinal); -var - I: Integer; -begin - If (Index > High(PlayLists)) then - exit; - - //Hide all Songs - For I := 0 to high(CatSongs.Song) do - CatSongs.Song[I].Visible := False; - - //Show Songs in PL - For I := 0 to high(PlayLists[Index].Items) do - begin - CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; - end; - - //Set CatSongsMode + Playlist Mode - CatSongs.CatNumShow := -3; - Mode := 2; - - //Set CurPlaylist - CurPlaylist := Index; - - //Show Cat in Topleft: - ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); - - //Fix SongSelection - ScreenSong.Interaction := 0; - ScreenSong.SelectNext; - ScreenSong.FixSelected; - - //Play correct Music - ScreenSong.ChangeMusic; -end; - -//---------- -//AddPlaylist - Adds a Playlist and Returns the Index -//---------- -Function TPlayListManager.AddPlaylist(Name: String): Cardinal; -var I: Integer; -begin - Result := Length(Playlists); - SetLength(Playlists, Result + 1); - - Playlists[Result].Name := Name; - - I := 1; - - if (not FileExists(PlaylistPath + Name + '.upl')) then - Playlists[Result].Filename := Name + '.upl' - else - begin - repeat - Inc(I); - until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); - Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; - end; - - //Save new Playlist - SavePlayList(Result); -end; - -//---------- -//DelPlaylist - Deletes a Playlist -//---------- -Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); -var - I: Integer; - Filename: String; -begin - If Index > High(Playlists) then - Exit; - - Filename := PlaylistPath + Playlists[Index].Filename; - - //If not FileExists or File is not Writeable then exit - If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then - Exit; - - - //Delete Playlist from FileSystem - if Not DeleteFile(Filename) then - Exit; - - //Delete Playlist from Array - //move all PLs to the Hole - For I := Index to High(Playlists)-1 do - PlayLists[I] := PlayLists[I+1]; - - //Delete last Playlist - SetLength (Playlists, High(Playlists)); - - //If Playlist is Displayed atm - //-> Display Songs - if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then - begin - ScreenSong.UnLoadDetailedCover; - ScreenSong.HideCatTL; - CatSongs.SetFilter('', 0); - ScreenSong.Interaction := 0; - ScreenSong.FixSelected; - ScreenSong.ChangeMusic; - end; -end; - -//---------- -//AddItem - Adds an Item to a specific Playlist -//---------- -Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); -var - P: Cardinal; - Len: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (SongID <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then - begin - Len := Length(Playlists[P].Items); - SetLength(Playlists[P].Items, Len + 1); - - Playlists[P].Items[Len].SongID := SongID; - Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; - Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; - - //Save Changes - SavePlayList(P); - - //Correct Display when Editing current Playlist - if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); - end; -end; - -//---------- -//DelItem - Deletes an Item from a specific Playlist -//---------- -Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); -var - I: Integer; - P: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (iItem <= high(Playlists[P].Items)) then - begin - //Move all entrys behind deleted one to Front - For I := iItem to High(Playlists[P].Items) - 1 do - Playlists[P].Items[I] := Playlists[P].Items[I + 1]; - - //Delete Last Entry - SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); - - //Save Changes - SavePlayList(P); - end; - - //Delete Playlist if Last Song is deleted - if (Length(PlayLists[P].Items) = 0) then - begin - DelPlaylist(P); - end - //Correct Display when Editing current Playlist - else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); -end; - -//---------- -//GetNames - Writes Playlist Names in a Array -//---------- -Procedure TPlayListManager.GetNames(var PLNames: array of String); -var - I: Integer; - Len: Integer; -begin - Len := High(Playlists); - - if (Length(PLNames) <> Len + 1) then - exit; - - For I := 0 to Len do - PLNames[I] := Playlists[I].Name; -end; - -//---------- -//GetIndexbySongID - Returns Index in the specified Playlist of the given Song -//---------- -Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; -var - P: Integer; - I: Integer; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - Result := -1; - - For I := 0 to high(Playlists[P].Items) do - begin - if (Playlists[P].Items[I].SongID = SongID) then - begin - Result := I; - Break; - end; - end; -end; - -end. +unit UPlaylist; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + TPlaylistItem = record + Artist: String; + Title: String; + SongID: Integer; + end; + + APlaylistItem = array of TPlaylistItem; + + TPlaylist = record + Name: String; + Filename: String; + Items: APlaylistItem; + end; + + APlaylist = array of TPlaylist; + + //---------- + //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) + //---------- + TPlaylistManager = class + private + + public + Mode: Byte; //Current Playlist Mode for SongScreen + CurPlayList: Cardinal; + CurItem: Cardinal; + + Playlists: APlaylist; + + constructor Create; + Procedure LoadPlayLists; + Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; + Procedure SavePlayList(Index: Cardinal); + + Procedure SetPlayList(Index: Cardinal); + + Function AddPlaylist(Name: String): Cardinal; + Procedure DelPlaylist(const Index: Cardinal); + + Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); + Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); + + Procedure GetNames(var PLNames: array of String); + Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; + end; + + {Modes: + 0: Standard Mode + 1: Category Mode + 2: PlayList Mode} + + var + PlayListMan: TPlaylistManager; + + +implementation + +uses USongs, + ULog, + UMain, + //UFiles, + UGraphic, + UThemes, + SysUtils; + +//---------- +//Create - Construct Class - Dummy for now +//---------- +constructor TPlayListManager.Create; +begin + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; +begin + SetLength(Playlists, 0); + + if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then + begin + repeat + Len := Length(Playlists); + SetLength(Playlists, Len +1); + + if not LoadPlayList (Len, Sr.Name) then + SetLength(Playlists, Len); + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +//---------- +//LoadPlayList - Load a Playlist in the Array +//---------- +Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; + var + F: TextFile; + Line: String; + PosDelimiter: Integer; + SongID: Integer; + Len: Integer; + + Function FindSong(Artist, Title: String): Integer; + var I: Integer; + begin + Result := -1; + + For I := low(CatSongs.Song) to high(CatSongs.Song) do + begin + if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then + begin + Result := I; + Break; + end; + end; + end; +begin + if not FileExists(PlayListPath + Filename) then + begin + Log.LogError('Could not load Playlist: ' + Filename); + Result := False; + Exit; + end; + Result := True; + + //Load File + AssignFile(F, PlayListPath + FileName); + Reset(F); + + //Set Filename + PlayLists[Index].Filename := Filename; + PlayLists[Index].Name := ''; + + //Read Until End of File + While not Eof(F) do + begin + //Read Curent Line + Readln(F, Line); + + if (Length(Line) > 0) then + begin + PosDelimiter := Pos(':', Line); + if (PosDelimiter <> 0) then + begin + //Comment or Name String + if (Line[1] = '#') then + begin + //Found Name Value + if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then + PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) + + end + //Song Entry + else + begin + SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); + if (SongID <> -1) then + begin + Len := Length(PlayLists[Index].Items); + SetLength(PlayLists[Index].Items, Len + 1); + + PlayLists[Index].Items[Len].SongID := SongID; + + PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); + PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); + end + else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); + end; + end; + end; + end; + + //If no special name is given, use Filename + if PlayLists[Index].Name = '' then + begin + PlayLists[Index].Name := ChangeFileExt(FileName, ''); + end; + + //Finish (Close File) + CloseFile(F); +end; + +//---------- +//SavePlayList - Saves the specified Playlist +//---------- +Procedure TPlayListManager.SavePlayList(Index: Cardinal); +var + F: TextFile; + I: Integer; +begin + if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then + begin + + //open File for Rewriting + AssignFile(F, PlaylistPath + Playlists[Index].Filename); + try + try + Rewrite(F); + + //Write Version (not nessecary but helpful) + WriteLn(F, '######################################'); + WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); + WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); + WriteLn(F, '######################################'); + + //Write Name Information + WriteLn(F, '#Name: ' + Playlists[Index].Name); + + //Write Song Information + WriteLn(F, '#Songs:'); + + For I := 0 to high(Playlists[Index].Items) do + begin + WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + end; + except + log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); + end; + finally + CloseFile(F); + end; + end; +end; + +//---------- +//SetPlayList - Display a Playlist in CatSongs +//---------- +Procedure TPlayListManager.SetPlayList(Index: Cardinal); +var + I: Integer; +begin + If (Index > High(PlayLists)) then + exit; + + //Hide all Songs + For I := 0 to high(CatSongs.Song) do + CatSongs.Song[I].Visible := False; + + //Show Songs in PL + For I := 0 to high(PlayLists[Index].Items) do + begin + CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; + end; + + //Set CatSongsMode + Playlist Mode + CatSongs.CatNumShow := -3; + Mode := 2; + + //Set CurPlaylist + CurPlaylist := Index; + + //Show Cat in Topleft: + ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); + + //Fix SongSelection + ScreenSong.Interaction := 0; + ScreenSong.SelectNext; + ScreenSong.FixSelected; + + //Play correct Music + ScreenSong.ChangeMusic; +end; + +//---------- +//AddPlaylist - Adds a Playlist and Returns the Index +//---------- +Function TPlayListManager.AddPlaylist(Name: String): Cardinal; +var I: Integer; +begin + Result := Length(Playlists); + SetLength(Playlists, Result + 1); + + Playlists[Result].Name := Name; + + I := 1; + + if (not FileExists(PlaylistPath + Name + '.upl')) then + Playlists[Result].Filename := Name + '.upl' + else + begin + repeat + Inc(I); + until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); + Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; + end; + + //Save new Playlist + SavePlayList(Result); +end; + +//---------- +//DelPlaylist - Deletes a Playlist +//---------- +Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); +var + I: Integer; + Filename: String; +begin + If Index > High(Playlists) then + Exit; + + Filename := PlaylistPath + Playlists[Index].Filename; + + //If not FileExists or File is not Writeable then exit + If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then + Exit; + + + //Delete Playlist from FileSystem + if Not DeleteFile(Filename) then + Exit; + + //Delete Playlist from Array + //move all PLs to the Hole + For I := Index to High(Playlists)-1 do + PlayLists[I] := PlayLists[I+1]; + + //Delete last Playlist + SetLength (Playlists, High(Playlists)); + + //If Playlist is Displayed atm + //-> Display Songs + if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then + begin + ScreenSong.UnLoadDetailedCover; + ScreenSong.HideCatTL; + CatSongs.SetFilter('', 0); + ScreenSong.Interaction := 0; + ScreenSong.FixSelected; + ScreenSong.ChangeMusic; + end; +end; + +//---------- +//AddItem - Adds an Item to a specific Playlist +//---------- +Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); +var + P: Cardinal; + Len: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (SongID <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then + begin + Len := Length(Playlists[P].Items); + SetLength(Playlists[P].Items, Len + 1); + + Playlists[P].Items[Len].SongID := SongID; + Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; + Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; + + //Save Changes + SavePlayList(P); + + //Correct Display when Editing current Playlist + if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); + end; +end; + +//---------- +//DelItem - Deletes an Item from a specific Playlist +//---------- +Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); +var + I: Integer; + P: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (iItem <= high(Playlists[P].Items)) then + begin + //Move all entrys behind deleted one to Front + For I := iItem to High(Playlists[P].Items) - 1 do + Playlists[P].Items[I] := Playlists[P].Items[I + 1]; + + //Delete Last Entry + SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); + + //Save Changes + SavePlayList(P); + end; + + //Delete Playlist if Last Song is deleted + if (Length(PlayLists[P].Items) = 0) then + begin + DelPlaylist(P); + end + //Correct Display when Editing current Playlist + else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); +end; + +//---------- +//GetNames - Writes Playlist Names in a Array +//---------- +Procedure TPlayListManager.GetNames(var PLNames: array of String); +var + I: Integer; + Len: Integer; +begin + Len := High(Playlists); + + if (Length(PLNames) <> Len + 1) then + exit; + + For I := 0 to Len do + PLNames[I] := Playlists[I].Name; +end; + +//---------- +//GetIndexbySongID - Returns Index in the specified Playlist of the given Song +//---------- +Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; +var + P: Integer; + I: Integer; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + Result := -1; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = SongID) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 8d3fa5f7..87c35cd8 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -2,6 +2,10 @@ unit URecord; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes, diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index 92b61e85..c8761df0 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -1,321 +1,326 @@ -unit UServices; - -interface - -{$I switches.inc} - -uses uPluginDefs, SysUtils; -{********************* - TServiceManager - Class for saving, managing and calling of Services. - Saves all Services and their Procs -*********************} - -type - TServiceName = String[60]; - PServiceInfo = ^TServiceInfo; - TServiceInfo = record - Self: THandle; //Handle of this Service - Hash: Integer; //4 Bit Hash of the Services Name - Name: TServiceName; //Name of this Service - - Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] - - Next: PServiceInfo; //Pointer to the Next Service in teh list - - //Here is s/t tricky - //To avoid writing of Wrapping Functions to offer a Service from a Class - //We save a Normal Proc or a Method of a Class - Case isClass: boolean of - False: (Proc: TUS_Service); //Proc that will be called on Event - True: (ProcOfClass: TUS_Service_of_Object); - end; - - TServiceManager = class - private - //Managing Service List - FirstService: PServiceInfo; - LastService: PServiceInfo; - - //Some Speed improvement by caching the last 4 called Services - //Most of the time a Service is called multiple times - ServiceCache: Array[0..3] of PServiceInfo; - NextCacheItem: Byte; - - //Next Service added gets this Handle: - NextHandle: THandle; - public - Constructor Create; - - Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; - Function DelService(const hService: THandle): integer; - - Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; - - Function NametoHash(const ServiceName: TServiceName): Integer; - Function ServiceExists(const ServiceName: PChar): Integer; - end; - -var - ServiceManager: TServiceManager; - -implementation -uses UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -Constructor TServiceManager.Create; -begin - FirstService := nil; - LastService := nil; - - ServiceCache[0] := nil; - ServiceCache[1] := nil; - ServiceCache[2] := nil; - ServiceCache[3] := nil; - - NextCacheItem := 0; - - NextHandle := 1; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Succesful created!'); - {$ENDIF} -end; - -//------------ -// Function Creates a new Service and Returns the Services Handle, -// 0 on Failure. (Name already exists) -//------------ -Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; -var - Cur: PServiceInfo; -begin - Result := 0; - - If (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - If (ServiceExists(ServiceName) = 0) then - begin //There is a Proc and the Service does not already exist - //Ok Add it! - - //Get Memory - GetMem(Cur, SizeOf(TServiceInfo)); - - //Fill it with Data - Cur.Next := nil; - - If (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := True; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := False; - Cur.Proc := Proc; - end; - - Cur.Self := NextHandle; - //Zero Name - Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - Cur.Name := String(ServiceName); - Cur.Hash := NametoHash(Cur.Name); - - //Add Owner to Service - Cur.Owner := Core.CurExecuted; - - //Add Service to the List - If (FirstService = nil) then - FirstService := Cur; - - If (LastService <> nil) then - LastService.Next := Cur; - - LastService := Cur; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); - {$ENDIF} - - //Inc Next Handle - Inc(NextHandle); - end - {$IFDEF DEBUG} - else WriteLn('ServiceManager: Try to readd Service: ' + ServiceName); - {$ENDIF} - end; -end; - -//------------ -// Function Destroys a Service, 0 on success, not 0 on Failure -//------------ -Function TServiceManager.DelService(const hService: THandle): integer; -var - Last, Cur: PServiceInfo; - I: Integer; -begin - Result := -1; - - Last := nil; - Cur := FirstService; - - //Search for Service to Delete - While (Cur <> nil) do - begin - If (Cur.Self = hService) then - begin //Found Service => Delete it - - //Delete from List - If (Last = nil) then //Found first Service - FirstService := Cur.Next - Else //Service behind the first - Last.Next := Cur.Next; - - //IF this is the LastService, correct LastService - If (Cur = LastService) then - LastService := Last; - - //Search for Service in Cache and delete it if found - For I := 0 to High(ServiceCache) do - If (ServiceCache[I] = Cur) then - begin - ServiceCache[I] := nil; - end; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Removed Service succesful: ' + Cur.Name); - {$ENDIF} - - //Free Memory - Freemem(Cur, SizeOf(TServiceInfo)); - - //Break the Loop - Break; - end; - - //Go to Next Service - Last := Cur; - Cur := Cur.Next; - end; -end; - -//------------ -// Function Calls a Services Proc -// Returns Services Return Value or SERVICE_NOT_FOUND on Failure -//------------ -Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; -var - SExists: Integer; - Service: PServiceInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute -begin - Result := SERVICE_NOT_FOUND; - SExists := ServiceExists(ServiceName); - If (SExists <> 0) then - begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - Service := Pointer(SExists); - - If (Service.isClass) then - //Use Proc of Class - Result := Service.ProcOfClass(wParam, lParam) - Else - //Use normal Proc - Result := Service.Proc(wParam, lParam); - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); - {$ENDIF} -end; - -//------------ -// Generates the Hash for the given Name -//------------ -Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; -asm - { CL: Counter; EAX: Result; EDX: Current Memory Address } - Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} - - Mov EDX, ServiceName {Save Address of String that should be "Hashed"} - - Mov EAX, [EDX] - - @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } - ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} - - LOOP @FoldLoop {Fold again if there are Chars Left} -end; - - -//------------ -// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 -//------------ -Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; -var - Name: TServiceName; - Hash: Integer; - Cur: PServiceInfo; - I: Byte; -begin - Result := 0; - // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) - //Zero Name: - Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - //Add Service Name - Name := String(ServiceName); - Hash := NametoHash(Name); - - //First of all Look for the Service in Cache - For I := 0 to High(ServiceCache) do - begin - If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then - begin - If (ServiceCache[I].Name = Name) then - begin //Found Service in Cache - Result := Integer(ServiceCache[I]); - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); - {$ENDIF} - - Break; - end; - end; - end; - - If (Result = 0) then - begin - Cur := FirstService; - While (Cur <> nil) do - begin - If (Cur.Hash = Hash) then - begin - If (Cur.Name = Name) then - begin //Found the Service - Result := Integer(Cur); - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Found Service in List: ''' + ServiceName + ''''); - {$ENDIF} - - //Add to Cache - ServiceCache[NextCacheItem] := Cur; - NextCacheItem := (NextCacheItem + 1) AND 3; - Break; - end; - end; - - Cur := Cur.Next; - end; - end; -end; - -end. \ No newline at end of file +unit UServices; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; +{********************* + TServiceManager + Class for saving, managing and calling of Services. + Saves all Services and their Procs +*********************} + +type + TServiceName = String[60]; + PServiceInfo = ^TServiceInfo; + TServiceInfo = record + Self: THandle; //Handle of this Service + Hash: Integer; //4 Bit Hash of the Services Name + Name: TServiceName; //Name of this Service + + Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + + Next: PServiceInfo; //Pointer to the Next Service in teh list + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to offer a Service from a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Service); //Proc that will be called on Event + True: (ProcOfClass: TUS_Service_of_Object); + end; + + TServiceManager = class + private + //Managing Service List + FirstService: PServiceInfo; + LastService: PServiceInfo; + + //Some Speed improvement by caching the last 4 called Services + //Most of the time a Service is called multiple times + ServiceCache: Array[0..3] of PServiceInfo; + NextCacheItem: Byte; + + //Next Service added gets this Handle: + NextHandle: THandle; + public + Constructor Create; + + Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; + Function DelService(const hService: THandle): integer; + + Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation +uses UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Succesful created!'); + {$ENDIF} +end; + +//------------ +// Function Creates a new Service and Returns the Services Handle, +// 0 on Failure. (Name already exists) +//------------ +Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; +var + Cur: PServiceInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + If (ServiceExists(ServiceName) = 0) then + begin //There is a Proc and the Service does not already exist + //Ok Add it! + + //Get Memory + GetMem(Cur, SizeOf(TServiceInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + Cur.Self := NextHandle; + //Zero Name + Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + Cur.Name := String(ServiceName); + Cur.Hash := NametoHash(Cur.Name); + + //Add Owner to Service + Cur.Owner := Core.CurExecuted; + + //Add Service to the List + If (FirstService = nil) then + FirstService := Cur; + + If (LastService <> nil) then + LastService.Next := Cur; + + LastService := Cur; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else WriteLn('ServiceManager: Try to readd Service: ' + ServiceName); + {$ENDIF} + end; +end; + +//------------ +// Function Destroys a Service, 0 on success, not 0 on Failure +//------------ +Function TServiceManager.DelService(const hService: THandle): integer; +var + Last, Cur: PServiceInfo; + I: Integer; +begin + Result := -1; + + Last := nil; + Cur := FirstService; + + //Search for Service to Delete + While (Cur <> nil) do + begin + If (Cur.Self = hService) then + begin //Found Service => Delete it + + //Delete from List + If (Last = nil) then //Found first Service + FirstService := Cur.Next + Else //Service behind the first + Last.Next := Cur.Next; + + //IF this is the LastService, correct LastService + If (Cur = LastService) then + LastService := Last; + + //Search for Service in Cache and delete it if found + For I := 0 to High(ServiceCache) do + If (ServiceCache[I] = Cur) then + begin + ServiceCache[I] := nil; + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Removed Service succesful: ' + Cur.Name); + {$ENDIF} + + //Free Memory + Freemem(Cur, SizeOf(TServiceInfo)); + + //Break the Loop + Break; + end; + + //Go to Next Service + Last := Cur; + Cur := Cur.Next; + end; +end; + +//------------ +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//------------ +Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; +var + SExists: Integer; + Service: PServiceInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := SERVICE_NOT_FOUND; + SExists := ServiceExists(ServiceName); + If (SExists <> 0) then + begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + Service := Pointer(SExists); + + If (Service.isClass) then + //Use Proc of Class + Result := Service.ProcOfClass(wParam, lParam) + Else + //Use normal Proc + Result := Service.Proc(wParam, lParam); + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} + + Mov EDX, ServiceName {Save Address of String that should be "Hashed"} + + Mov EAX, [EDX] + + @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} + + LOOP @FoldLoop {Fold again if there are Chars Left} +end; + + +//------------ +// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 +//------------ +Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; +var + Name: TServiceName; + Hash: Integer; + Cur: PServiceInfo; + I: Byte; +begin + Result := 0; + // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) + //Zero Name: + Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + //Add Service Name + Name := String(ServiceName); + Hash := NametoHash(Name); + + //First of all Look for the Service in Cache + For I := 0 to High(ServiceCache) do + begin + If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then + begin + If (ServiceCache[I].Name = Name) then + begin //Found Service in Cache + Result := Integer(ServiceCache[I]); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); + {$ENDIF} + + Break; + end; + end; + end; + + If (Result = 0) then + begin + Cur := FirstService; + While (Cur <> nil) do + begin + If (Cur.Hash = Hash) then + begin + If (Cur.Name = Name) then + begin //Found the Service + Result := Integer(Cur); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in List: ''' + ServiceName + ''''); + {$ENDIF} + + //Add to Cache + ServiceCache[NextCacheItem] := Cur; + NextCacheItem := (NextCacheItem + 1) AND 3; + Break; + end; + end; + + Cur := Cur.Next; + end; + end; +end; + +end. diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index d5256dc9..c7213180 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -1,986 +1,990 @@ -unit USingScores; - -interface - -{$I switches.inc} - -uses UThemes, - OpenGl12, - UTexture; - -////////////////////////////////////////////////////////////// -// ATTENTION: // -// Enabled Flag does not Work atm. This should cause Popups // -// Not to Move and Scores to stay until Renenabling. // -// To use e.g. in Pause Mode // -// Also InVisible Flag causes Attributes not to change. // -// This should be fixed after next Draw when Visible = True,// -// but not testet yet // -////////////////////////////////////////////////////////////// - -//Some Constances containing Options that could change by time -const - MaxPlayers = 6; //Maximum of Players that could be added - MaxPositions = 6; //Maximum of Score Positions that could be added - -type - //----------- - // TScorePlayer - Record Containing Information about a Players Score - //----------- - TScorePlayer = record - Position: Byte; //Index of the Position where the Player should be Drawn - Enabled: Boolean; //Is the Score Display Enabled - Visible: Boolean; //Is the Score Display Visible - Score: Word; //Current Score of the Player - ScoreDisplayed: Word; //Score cur. Displayed(for counting up) - ScoreBG: TTexture;//Texture of the Players Scores BG - Color: TRGB; //Teh Players Color - RBPos: Real; //Cur. Percentille of the Rating Bar - RBTarget: Real; //Target Position of Rating Bar - RBVisible:Boolean; //Is Rating bar Drawn - end; - aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; - - //----------- - // TScorePosition - Record Containing Information about a Score Position, that can be used - //----------- - PScorePosition = ^TScorePosition; - TScorePosition = record - //The Position is Used for Which Playercount - PlayerCount: Byte; - // 1 - One Player per Screen - // 2 - 2 Players per Screen - // 4 - 3 Players per Screen - // 6 would be 2 and 3 Players per Screen - - BGX: Real; //X Position of the Score BG - BGY: Real; //Y Position of the Score BG - BGW: Real; //Width of the Score BG - BGH: Real; //Height of the Score BG - - RBX: Real; //X Position of the Rating Bar - RBY: Real; //Y Position of the Rating Bar - RBW: Real; //Width of the Rating Bar - RBH: Real; //Height of the Rating Bar - - TextX: Real; //X Position of the Score Text - TextY: Real; //Y Position of the Score Text - TextFont: Byte; //Font of the Score Text - TextSize: Byte; //Size of the Score Text - - PUW: Real; //Width of the LineBonus Popup - PUH: Real; //Height of the LineBonus Popup - PUFont: Byte; //Font for the PopUps - PUFontSize: Byte; //FontSize for the PopUps - PUStartX: Real; //X Start Position of the LineBonus Popup - PUStartY: Real; //Y Start Position of the LineBonus Popup - PUTargetX: Real; //X Target Position of the LineBonus Popup - PUTargetY: Real; //Y Target Position of the LineBonus Popup - end; - aScorePosition = array[0..MaxPositions-1] of TScorePosition; - - //----------- - // TScorePopUp - Record Containing Information about a LineBonus Popup - // List, Next Item is Saved in Next attribute - //----------- - PScorePopUp = ^TScorePopUp; - TScorePopUp = record - Player: Byte; //Index of the PopUps Player - TimeStamp: Cardinal; //Timestamp of Popups Spawn - Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) - ScoreGiven:Word; //Score that has already been given to the Player - ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score - Next: PScorePopUp; //Next Item in List - end; - aScorePopUp = array of TScorePopUp; - - //----------- - // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups - //----------- - TSingScores = class - private - Positions: aScorePosition; - aPlayers: aScorePlayer; - oPositionCount: Byte; - oPlayerCount: Byte; - - //Saves the First and Last Popup of the List - FirstPopUp: PScorePopUp; - LastPopUp: PScorePopUp; - - //Procedure Draws a Popup by Pointer - Procedure DrawPopUp(const PopUp: PScorePopUp); - - //Procedure Draws a Score by Playerindex - Procedure DrawScore(const Index: Integer); - - //Procedure Draws the RatingBar by Playerindex - Procedure DrawRatingBar(const Index: Integer); - - //Procedure Removes a PopUp w/o destroying the List - Procedure KillPopUp(const last, cur: PScorePopUp); - public - Settings: record //Record containing some Displaying Options - Phase1Time: Real; //time for Phase 1 to complete (in msecs) - //The Plop Up of the PopUp - Phase2Time: Real; //time for Phase 2 to complete (in msecs) - //The Moving (mainly Upwards) of the Popup - Phase3Time: Real; //time for Phase 3 to complete (in msecs) - //The Fade out and Score adding - - PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating - - RatingBar_BG_Tex: TTexture; //Rating Bar Texs - RatingBar_FG_Tex: TTexture; - RatingBar_Bar_Tex: TTexture; - - end; - - Visible: Boolean; //Visibility of all Scores - Enabled: Boolean; //Scores are changed, PopUps are Moved etc. - RBVisible: Boolean; //Visibility of all Rating Bars - - //Propertys for Reading Position and Playercount - Property PositionCount: Byte read oPositionCount; - Property PlayerCount: Byte read oPlayerCount; - Property Players: aScorePlayer read aPlayers; - - //Constructor just sets some standard Settings - Constructor Create; - - //Procedure Adds a Position to Array and Increases Position Count - Procedure AddPosition(const pPosition: PScorePosition); - - //Procedure Adds a Player to Array and Increases Player Count - Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); - - //Change a Players Visibility, Enable - Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); - Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); - - //Procedure Deletes all Player Information - Procedure ClearPlayers; - - //Procedure Deletes Positions and Playerinformation - Procedure Clear; - - //Procedure Loads some Settings and the Positions from Theme - Procedure LoadfromTheme; - - //Procedure has to be called after Positions and Players have been added, before first call of Draw - //It gives every Player a Score Position - Procedure Init; - - //Spawns a new Line Bonus PopUp for the Player - Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); - - //Removes all PopUps from Mem - Procedure KillAllPopUps; - - //Procedure Draws Scores and Linebonus PopUps - Procedure Draw; - end; - - -implementation - -uses SDL, - SysUtils, - ULog, - UGraphic, - TextGL; - -//----------- -//Constructor just sets some standard Settings -//----------- -Constructor TSingScores.Create; -begin - //Clear PopupList Pointers - FirstPopUp := nil; - LastPopUp := nil; - - //Clear Variables - Visible := True; - Enabled := True; - RBVisible := True; - - //Clear Position Index - oPositionCount := 0; - oPlayerCount := 0; - - Settings.Phase1Time := 1000; - Settings.Phase2Time := 2000; - Settings.Phase3Time := 2000; - - Settings.PopUpTex[0].TexNum := High(gluInt); - Settings.PopUpTex[1].TexNum := High(gluInt); - Settings.PopUpTex[2].TexNum := High(gluInt); - Settings.PopUpTex[3].TexNum := High(gluInt); - Settings.PopUpTex[4].TexNum := High(gluInt); - Settings.PopUpTex[5].TexNum := High(gluInt); - Settings.PopUpTex[6].TexNum := High(gluInt); - Settings.PopUpTex[7].TexNum := High(gluInt); - Settings.PopUpTex[8].TexNum := High(gluInt); - - Settings.RatingBar_BG_Tex.TexNum := High(gluInt); - Settings.RatingBar_FG_Tex.TexNum := High(gluInt); - Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); -end; - -//----------- -//Procedure Adds a Position to Array and Increases Position Count -//----------- -Procedure TSingScores.AddPosition(const pPosition: PScorePosition); -begin - if (PositionCount < MaxPositions) then - begin - Positions[PositionCount] := pPosition^; - - Inc(oPositionCount); - end; -end; - -//----------- -//Procedure Adds a Player to Array and Increases Player Count -//----------- -Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); -begin - if (PlayerCount < MaxPlayers) then - begin - aPlayers[PlayerCount].Position := High(byte); - aPlayers[PlayerCount].Enabled := Enabled; - aPlayers[PlayerCount].Visible := Visible; - aPlayers[PlayerCount].Score := Score; - aPlayers[PlayerCount].ScoreDisplayed := Score; - aPlayers[PlayerCount].ScoreBG := ScoreBG; - aPlayers[PlayerCount].Color := Color; - aPlayers[PlayerCount].RBPos := 0.5; - aPlayers[PlayerCount].RBTarget := 0.5; - aPlayers[PlayerCount].RBVisible := True; - - Inc(oPlayerCount); - end; -end; - -//----------- -//Change a Players Visibility -//----------- -Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Visible := pVisible; -end; - -//----------- -//Change Player Enabled -//----------- -Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Enabled := pEnabled; -end; - -//----------- -//Procedure Deletes all Player Information -//----------- -Procedure TSingScores.ClearPlayers; -begin - KillAllPopUps; - oPlayerCount := 0; -end; - -//----------- -//Procedure Deletes Positions and Playerinformation -//----------- -Procedure TSingScores.Clear; -begin - KillAllPopUps; - oPlayerCount := 0; - oPositionCount := 0; -end; - -//----------- -//Procedure Loads some Settings and the Positions from Theme -//----------- -Procedure TSingScores.LoadfromTheme; -var I: Integer; - Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); - var nPosition: TScorePosition; - begin - nPosition.PlayerCount := PC; //Only for one Player Playing - - nPosition.BGX := ScoreStatic.X; - nPosition.BGY := ScoreStatic.Y; - nPosition.BGW := ScoreStatic.W; - nPosition.BGH := ScoreStatic.H; - - nPosition.TextX := ScoreText.X; - nPosition.TextY := ScoreText.Y; - nPosition.TextFont := ScoreText.Font; - nPosition.TextSize := ScoreText.Size; - - nPosition.RBX := SingBarStatic.X; - nPosition.RBY := SingBarStatic.Y; - nPosition.RBW := SingBarStatic.W; - nPosition.RBH := SingBarStatic.H; - - nPosition.PUW := nPosition.BGW; - nPosition.PUH := nPosition.BGH; - - nPosition.PUFont := 2; - nPosition.PUFontSize := 6; - - nPosition.PUStartX := nPosition.BGX; - nPosition.PUStartY := nPosition.TextY + 65; - - nPosition.PUTargetX := nPosition.BGX; - nPosition.PUTargetY := nPosition.TextY; - - AddPosition(@nPosition); - end; -begin - Clear; - - //Set Textures - //Popup Tex - For I := 0 to 8 do - Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; - - //Rating Bar Tex - Settings.RatingBar_BG_Tex := Tex_SingBar_Back; - Settings.RatingBar_FG_Tex := Tex_SingBar_Front; - Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; - - //Load Positions from Theme - - // Player1: - AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); - AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); - AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); - - // Player2: - AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); - AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); - - // Player3: - AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); -end; - -//----------- -//Spawns a new Line Bonus PopUp for the Player -//----------- -Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); -var Cur: PScorePopUp; -begin - if (PlayerIndex < PlayerCount) then - begin - //Get Memory and Add Data - GetMem(Cur, SizeOf(TScorePopUp)); - - Cur.Player := PlayerIndex; - Cur.TimeStamp := SDL_GetTicks; - Cur.Rating := Rating; - Cur.ScoreGiven:= 0; - If (Players[PlayerIndex].Score < Score) then - begin - Cur.ScoreDiff := Score - Players[PlayerIndex].Score; - aPlayers[PlayerIndex].Score := Score; - end - else - Cur.ScoreDiff := 0; - Cur.Next := nil; - - //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); - - //Add it to the Chain - if (FirstPopUp = nil) then - //the first PopUp in the List - FirstPopUp := Cur - else - //second or earlier popup - LastPopUp.Next := Cur; - - //Set new Popup to Last PopUp in the List - LastPopUp := Cur; - end - else - Log.LogError('TSingScores: Try to add PopUp for not existing player'); -end; - -//----------- -// Removes a PopUp w/o destroying the List -//----------- -Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); -var - lTempA , - lTempB : real; -begin - //Give Player the Last Points that missing till now - aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; - - //Change Bars Position - - // TODO : JB_Lazarus - Exception=Invalid floating point operation - // AT THIS LINE ! - - {$IFDEF LAZARUS} -(* - writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); - writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); - writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); - writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); - writeln( '' ); -*) - {$ENDIF} - - lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); - lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); - - {$IFDEF LAZARUS} -(* - writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); - writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); - writeln( '----------------------------------------------------------' ); -*) - {$ENDIF} - - if ( lTempA > 0 ) AND - ( lTempB > 0 ) THEN - begin - aPlayers[Cur.Player].RBTarget := lTempA / lTempB; - end; - - If (aPlayers[Cur.Player].RBTarget > 1) then - aPlayers[Cur.Player].RBTarget := 1 - else - If (aPlayers[Cur.Player].RBTarget < 0) then - aPlayers[Cur.Player].RBTarget := 0; - - //If this is the First PopUp => Make Next PopUp the First - If (Cur = FirstPopUp) then - FirstPopUp := Cur.Next - //Else => Remove Curent Popup from Chain - else - Last.Next := Cur.Next; - - //If this is the Last PopUp, Make PopUp before the Last - If (Cur = LastPopUp) then - LastPopUp := Last; - - //Free the Memory - FreeMem(Cur, SizeOf(TScorePopUp)); -end; - -//----------- -//Removes all PopUps from Mem -//----------- -Procedure TSingScores.KillAllPopUps; -var - Cur: PScorePopUp; - Last: PScorePopUp; -begin - Cur := FirstPopUp; - - //Remove all PopUps: - While (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TScorePopUp)); - end; - - FirstPopUp := nil; - LastPopUp := nil; -end; - -//----------- -//Init - has to be called after Positions and Players have been added, before first call of Draw -//It gives every Player a Score Position -//----------- -Procedure TSingScores.Init; -var - PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen - I, J: Integer; - MaxPlayersperScreen: Byte; - CurPlayer: Byte; - - Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; - var I: Integer; - begin - Result := 0; - bPlayerCount := 1 shl (bPlayerCount - 1); - - For I := 0 to PositionCount-1 do - begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then - Inc(Result); - end; - end; - - Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; - var I: Integer; - begin - bPlayerCount := 1 shl (bPlayerCount - 1); - Result := High(Byte); - - For I := 0 to PositionCount-1 do - begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then - begin - If (bPlayer = 0) then - begin - Result := I; - Break; - end - else - Dec(bPlayer); - end; - end; - end; - -begin - - For I := 1 to 6 do - begin - //If there are enough Positions -> Write to MaxPlayers - If (GetPositionCountbyPlayerCount(I) = I) then - MaxPlayersperScreen := I - else - Break; - end; - - - //Split Players to both Screen or Display on One Screen - if (Screens = 2) and (MaxPlayersperScreen < PlayerCount) then - begin - PlC[0] := PlayerCount div 2 + PlayerCount mod 2; - PlC[1] := PlayerCount div 2; - end - else - begin - PlC[0] := PlayerCount; - PlC[1] := 0; - end; - - - //Check if there are enough Positions for all Players - For I := 0 to Screens - 1 do - begin - if (PlC[I] > MaxPlayersperScreen) then - begin - PlC[I] := MaxPlayersperScreen; - Log.LogError('More Players than available Positions, TSingScores'); - end; - end; - - CurPlayer := 0; - //Give every Player a Position - For I := 0 to Screens - 1 do - For J := 0 to PlC[I]-1 do - begin - aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); - //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); - Inc(CurPlayer); - end; -end; - -//----------- -//Procedure Draws Scores and Linebonus PopUps -//----------- -Procedure TSingScores.Draw; -var - I: Integer; - CurTime: Cardinal; - CurPopUp, LastPopUp: PScorePopUp; -begin - CurTime := SDL_GetTicks; - - If Visible then - begin - //Draw Popups - LastPopUp := nil; - CurPopUp := FirstPopUp; - - While (CurPopUp <> nil) do - begin - if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then - begin - KillPopUp(LastPopUp, CurPopUp); - if (LastPopUp = nil) then - CurPopUp := FirstPopUp - else - CurPopUp := LastPopUp.Next; - end - else - begin - DrawPopUp(CurPopUp); - LastPopUp := CurPopUp; - CurPopUp := LastPopUp.Next; - end; - end; - - - IF (RBVisible) then - //Draw Players w/ Rating Bar - For I := 0 to PlayerCount-1 do - begin - DrawScore(I); - DrawRatingBar(I); - end - else - //Draw Players w/o Rating Bar - For I := 0 to PlayerCount-1 do - begin - DrawScore(I); - end; - - end; //eo Visible -end; - -//----------- -//Procedure Draws a Popup by Pointer -//----------- -Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); -var - Progress: Real; - CurTime: Cardinal; - X, Y, W, H, Alpha: Real; - FontSize: Byte; - TimeDiff: Cardinal; - PIndex: Byte; - TextLen: Real; - ScoretoAdd: Word; - PosDiff: Real; -begin - if (PopUp <> nil) then - begin - //Only Draw if Player has a Position - PIndex := Players[PopUp.Player].Position; - If PIndex <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then - begin - CurTime := SDL_GetTicks; - If Not (Enabled AND Players[PopUp.Player].Enabled) then - //Increase Timestamp with TIem where there is no Movement ... - begin - //Inc(PopUp.TimeStamp, LastRender); - end; - TimeDiff := CurTime - PopUp.TimeStamp; - - //Get Position of PopUp - PIndex := PIndex AND 127; - - - //Check for Phase ... - If (TimeDiff <= Settings.Phase1Time) then - begin - //Phase 1 - The Ploping up - Progress := TimeDiff / Settings.Phase1Time; - - - W := Positions[PIndex].PUW * Sin(Progress/2*Pi); - H := Positions[PIndex].PUH * Sin(Progress/2*Pi); - - X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; - Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; - - FontSize := Round(Progress * Positions[PIndex].PUFontSize); - Alpha := 1; - end - - Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then - begin - //Phase 2 - The Moving - Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If PosDiff > 0 then - PosDiff := PosDiff + W; - X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If PosDiff < 0 then - PosDiff := PosDiff + Positions[PIndex].BGH; - Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); - - FontSize := Positions[PIndex].PUFontSize; - Alpha := 1 - 0.3 * Progress; - end - - else - begin - //Phase 3 - The Fading out + Score adding - Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; - - If (PopUp.Rating > 0) then - begin - //Add Scores if Player Enabled - If (Enabled AND Players[PopUp.Player].Enabled) then - begin - ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; - Inc(PopUp.ScoreGiven, ScoreToAdd); - aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; - - //Change Bars Position - aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); - If (aPlayers[PopUp.Player].RBTarget > 1) then - aPlayers[PopUp.Player].RBTarget := 1 - else If (aPlayers[PopUp.Player].RBTarget < 0) then - aPlayers[PopUp.Player].RBTarget := 0; - end; - - //Set Positions etc. - Alpha := 0.7 - 0.7 * Progress; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If (PosDiff > 0) then - PosDiff := W - else - PosDiff := 0; - X := Positions[PIndex].PUTargetX + PosDiff * Progress; - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If (PosDiff < 0) then - PosDiff := -Positions[PIndex].BGH - else - PosDiff := 0; - Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); - - FontSize := Positions[PIndex].PUFontSize; - end - else - begin - //Here the Effect that Should be shown if a PopUp without Score is Drawn - //And or Spawn with the GraphicObjects etc. - //Some Work for Blindy to do :P - - //ATM: Just Let it Slide in the Scores just like the Normal PopUp - Alpha := 0; - end; - end; - - //Draw PopUp - - if (Alpha > 0) AND (Players[PopUp.Player].Visible) then - begin - //Draw BG: - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, Alpha); - glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - //Set FontStyle and Size - SetFontStyle(Positions[PIndex].PUFont); - SetFontItalic(False); - SetFontSize(FontSize); - - //Draw Text - TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); - - //Color and Pos - SetFontPos (X + (W - TextLen) / 2, Y + 12); - glColor4f(1, 1, 1, Alpha); - - //Draw - glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); - end; //eo Alpha check - end; //eo Right Screen - end; //eo Player has Position - end - else - Log.LogError('TSingScores: Try to Draw a not existing PopUp'); -end; - -//----------- -//Procedure Draws a Score by Playerindex -//----------- -Procedure TSingScores.DrawScore(const Index: Integer); -var - Position: PScorePosition; - ScoreStr: String; -begin - //Only Draw if Player has a Position - If Players[Index].Position <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then - begin - Position := @Positions[Players[Index].Position and 127]; - - //Draw ScoreBG - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, 1); - glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); - glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - //Draw Score Text - SetFontStyle(Position.TextFont); - SetFontItalic(False); - SetFontSize(Position.TextSize); - SetFontPos(Position.TextX, Position.TextY); - - ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; - While (Length(ScoreStr) < 5) do - ScoreStr := '0' + ScoreStr; - - glPrint(PChar(ScoreStr)); - - end; //eo Right Screen - end; //eo Player has Position -end; - - -Procedure TSingScores.DrawRatingBar(const Index: Integer); -var - Position: PScorePosition; - R,G,B, Size: Real; - Diff: Real; -begin - //Only Draw if Player has a Position - If Players[Index].Position <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) AND (Players[index].RBVisible AND Players[index].Visible) then - begin - Position := @Positions[Players[Index].Position and 127]; - - If (Enabled AND Players[Index].Enabled) then - begin - //Move Position if Enabled - Diff := Players[Index].RBTarget - Players[Index].RBPos; - If(Abs(Diff) < 0.02) then - aPlayers[Index].RBPos := aPlayers[Index].RBTarget - else - aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; - end; - - //Get Colors for RatingBar - If Players[index].RBPos <=0.22 then - begin - R := 1; - G := 0; - B := 0; - end - Else If Players[index].RBPos <=0.42 then - begin - R := 1; - G := Players[index].RBPos*5; - B := 0; - end - Else If Players[index].RBPos <=0.57 then - begin - R := 1; - G := 1; - B := 0; - end - Else If Players[index].RBPos <=0.77 then - begin - R := 1-(Players[index].RBPos-0.57)*5; - G := 1; - B := 0; - end - else - begin - R := 0; - G := 1; - B := 0; - end; - - //Enable all glFuncs Needed - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - //Draw RatingBar BG - glColor4f(1, 1, 1, 0.8); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); - glVertex2f(Position.RBX+Position.RBW, Position.RBY); - glEnd; - - //Draw Rating bar itself - Size := Position.RBX + Position.RBW * Players[Index].RBPos; - glColor4f(R, G, B, 1); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Size, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); - glVertex2f(Size, Position.RBY); - glEnd; - - //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) - glColor4f(1, 1, 1, 0.6); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); - glVertex2f(Position.RBX + Position.RBW, Position.RBY); - glEnd; - - //Disable all Enabled glFuncs - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - end; //eo Right Screen - end; //eo Player has Position -end; - -end. +unit USingScores; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UThemes, + OpenGl12, + UTexture; + +////////////////////////////////////////////////////////////// +// ATTENTION: // +// Enabled Flag does not Work atm. This should cause Popups // +// Not to Move and Scores to stay until Renenabling. // +// To use e.g. in Pause Mode // +// Also InVisible Flag causes Attributes not to change. // +// This should be fixed after next Draw when Visible = True,// +// but not testet yet // +////////////////////////////////////////////////////////////// + +//Some Constances containing Options that could change by time +const + MaxPlayers = 6; //Maximum of Players that could be added + MaxPositions = 6; //Maximum of Score Positions that could be added + +type + //----------- + // TScorePlayer - Record Containing Information about a Players Score + //----------- + TScorePlayer = record + Position: Byte; //Index of the Position where the Player should be Drawn + Enabled: Boolean; //Is the Score Display Enabled + Visible: Boolean; //Is the Score Display Visible + Score: Word; //Current Score of the Player + ScoreDisplayed: Word; //Score cur. Displayed(for counting up) + ScoreBG: TTexture;//Texture of the Players Scores BG + Color: TRGB; //Teh Players Color + RBPos: Real; //Cur. Percentille of the Rating Bar + RBTarget: Real; //Target Position of Rating Bar + RBVisible:Boolean; //Is Rating bar Drawn + end; + aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; + + //----------- + // TScorePosition - Record Containing Information about a Score Position, that can be used + //----------- + PScorePosition = ^TScorePosition; + TScorePosition = record + //The Position is Used for Which Playercount + PlayerCount: Byte; + // 1 - One Player per Screen + // 2 - 2 Players per Screen + // 4 - 3 Players per Screen + // 6 would be 2 and 3 Players per Screen + + BGX: Real; //X Position of the Score BG + BGY: Real; //Y Position of the Score BG + BGW: Real; //Width of the Score BG + BGH: Real; //Height of the Score BG + + RBX: Real; //X Position of the Rating Bar + RBY: Real; //Y Position of the Rating Bar + RBW: Real; //Width of the Rating Bar + RBH: Real; //Height of the Rating Bar + + TextX: Real; //X Position of the Score Text + TextY: Real; //Y Position of the Score Text + TextFont: Byte; //Font of the Score Text + TextSize: Byte; //Size of the Score Text + + PUW: Real; //Width of the LineBonus Popup + PUH: Real; //Height of the LineBonus Popup + PUFont: Byte; //Font for the PopUps + PUFontSize: Byte; //FontSize for the PopUps + PUStartX: Real; //X Start Position of the LineBonus Popup + PUStartY: Real; //Y Start Position of the LineBonus Popup + PUTargetX: Real; //X Target Position of the LineBonus Popup + PUTargetY: Real; //Y Target Position of the LineBonus Popup + end; + aScorePosition = array[0..MaxPositions-1] of TScorePosition; + + //----------- + // TScorePopUp - Record Containing Information about a LineBonus Popup + // List, Next Item is Saved in Next attribute + //----------- + PScorePopUp = ^TScorePopUp; + TScorePopUp = record + Player: Byte; //Index of the PopUps Player + TimeStamp: Cardinal; //Timestamp of Popups Spawn + Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) + ScoreGiven:Word; //Score that has already been given to the Player + ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score + Next: PScorePopUp; //Next Item in List + end; + aScorePopUp = array of TScorePopUp; + + //----------- + // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups + //----------- + TSingScores = class + private + Positions: aScorePosition; + aPlayers: aScorePlayer; + oPositionCount: Byte; + oPlayerCount: Byte; + + //Saves the First and Last Popup of the List + FirstPopUp: PScorePopUp; + LastPopUp: PScorePopUp; + + //Procedure Draws a Popup by Pointer + Procedure DrawPopUp(const PopUp: PScorePopUp); + + //Procedure Draws a Score by Playerindex + Procedure DrawScore(const Index: Integer); + + //Procedure Draws the RatingBar by Playerindex + Procedure DrawRatingBar(const Index: Integer); + + //Procedure Removes a PopUp w/o destroying the List + Procedure KillPopUp(const last, cur: PScorePopUp); + public + Settings: record //Record containing some Displaying Options + Phase1Time: Real; //time for Phase 1 to complete (in msecs) + //The Plop Up of the PopUp + Phase2Time: Real; //time for Phase 2 to complete (in msecs) + //The Moving (mainly Upwards) of the Popup + Phase3Time: Real; //time for Phase 3 to complete (in msecs) + //The Fade out and Score adding + + PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating + + RatingBar_BG_Tex: TTexture; //Rating Bar Texs + RatingBar_FG_Tex: TTexture; + RatingBar_Bar_Tex: TTexture; + + end; + + Visible: Boolean; //Visibility of all Scores + Enabled: Boolean; //Scores are changed, PopUps are Moved etc. + RBVisible: Boolean; //Visibility of all Rating Bars + + //Propertys for Reading Position and Playercount + Property PositionCount: Byte read oPositionCount; + Property PlayerCount: Byte read oPlayerCount; + Property Players: aScorePlayer read aPlayers; + + //Constructor just sets some standard Settings + Constructor Create; + + //Procedure Adds a Position to Array and Increases Position Count + Procedure AddPosition(const pPosition: PScorePosition); + + //Procedure Adds a Player to Array and Increases Player Count + Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + + //Change a Players Visibility, Enable + Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); + Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + + //Procedure Deletes all Player Information + Procedure ClearPlayers; + + //Procedure Deletes Positions and Playerinformation + Procedure Clear; + + //Procedure Loads some Settings and the Positions from Theme + Procedure LoadfromTheme; + + //Procedure has to be called after Positions and Players have been added, before first call of Draw + //It gives every Player a Score Position + Procedure Init; + + //Spawns a new Line Bonus PopUp for the Player + Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + + //Removes all PopUps from Mem + Procedure KillAllPopUps; + + //Procedure Draws Scores and Linebonus PopUps + Procedure Draw; + end; + + +implementation + +uses SDL, + SysUtils, + ULog, + UGraphic, + TextGL; + +//----------- +//Constructor just sets some standard Settings +//----------- +Constructor TSingScores.Create; +begin + //Clear PopupList Pointers + FirstPopUp := nil; + LastPopUp := nil; + + //Clear Variables + Visible := True; + Enabled := True; + RBVisible := True; + + //Clear Position Index + oPositionCount := 0; + oPlayerCount := 0; + + Settings.Phase1Time := 1000; + Settings.Phase2Time := 2000; + Settings.Phase3Time := 2000; + + Settings.PopUpTex[0].TexNum := High(gluInt); + Settings.PopUpTex[1].TexNum := High(gluInt); + Settings.PopUpTex[2].TexNum := High(gluInt); + Settings.PopUpTex[3].TexNum := High(gluInt); + Settings.PopUpTex[4].TexNum := High(gluInt); + Settings.PopUpTex[5].TexNum := High(gluInt); + Settings.PopUpTex[6].TexNum := High(gluInt); + Settings.PopUpTex[7].TexNum := High(gluInt); + Settings.PopUpTex[8].TexNum := High(gluInt); + + Settings.RatingBar_BG_Tex.TexNum := High(gluInt); + Settings.RatingBar_FG_Tex.TexNum := High(gluInt); + Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); +end; + +//----------- +//Procedure Adds a Position to Array and Increases Position Count +//----------- +Procedure TSingScores.AddPosition(const pPosition: PScorePosition); +begin + if (PositionCount < MaxPositions) then + begin + Positions[PositionCount] := pPosition^; + + Inc(oPositionCount); + end; +end; + +//----------- +//Procedure Adds a Player to Array and Increases Player Count +//----------- +Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); +begin + if (PlayerCount < MaxPlayers) then + begin + aPlayers[PlayerCount].Position := High(byte); + aPlayers[PlayerCount].Enabled := Enabled; + aPlayers[PlayerCount].Visible := Visible; + aPlayers[PlayerCount].Score := Score; + aPlayers[PlayerCount].ScoreDisplayed := Score; + aPlayers[PlayerCount].ScoreBG := ScoreBG; + aPlayers[PlayerCount].Color := Color; + aPlayers[PlayerCount].RBPos := 0.5; + aPlayers[PlayerCount].RBTarget := 0.5; + aPlayers[PlayerCount].RBVisible := True; + + Inc(oPlayerCount); + end; +end; + +//----------- +//Change a Players Visibility +//----------- +Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Visible := pVisible; +end; + +//----------- +//Change Player Enabled +//----------- +Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Enabled := pEnabled; +end; + +//----------- +//Procedure Deletes all Player Information +//----------- +Procedure TSingScores.ClearPlayers; +begin + KillAllPopUps; + oPlayerCount := 0; +end; + +//----------- +//Procedure Deletes Positions and Playerinformation +//----------- +Procedure TSingScores.Clear; +begin + KillAllPopUps; + oPlayerCount := 0; + oPositionCount := 0; +end; + +//----------- +//Procedure Loads some Settings and the Positions from Theme +//----------- +Procedure TSingScores.LoadfromTheme; +var I: Integer; + Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); + var nPosition: TScorePosition; + begin + nPosition.PlayerCount := PC; //Only for one Player Playing + + nPosition.BGX := ScoreStatic.X; + nPosition.BGY := ScoreStatic.Y; + nPosition.BGW := ScoreStatic.W; + nPosition.BGH := ScoreStatic.H; + + nPosition.TextX := ScoreText.X; + nPosition.TextY := ScoreText.Y; + nPosition.TextFont := ScoreText.Font; + nPosition.TextSize := ScoreText.Size; + + nPosition.RBX := SingBarStatic.X; + nPosition.RBY := SingBarStatic.Y; + nPosition.RBW := SingBarStatic.W; + nPosition.RBH := SingBarStatic.H; + + nPosition.PUW := nPosition.BGW; + nPosition.PUH := nPosition.BGH; + + nPosition.PUFont := 2; + nPosition.PUFontSize := 6; + + nPosition.PUStartX := nPosition.BGX; + nPosition.PUStartY := nPosition.TextY + 65; + + nPosition.PUTargetX := nPosition.BGX; + nPosition.PUTargetY := nPosition.TextY; + + AddPosition(@nPosition); + end; +begin + Clear; + + //Set Textures + //Popup Tex + For I := 0 to 8 do + Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; + + //Rating Bar Tex + Settings.RatingBar_BG_Tex := Tex_SingBar_Back; + Settings.RatingBar_FG_Tex := Tex_SingBar_Front; + Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; + + //Load Positions from Theme + + // Player1: + AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); + AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); + AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); + + // Player2: + AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); + AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); + + // Player3: + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); +end; + +//----------- +//Spawns a new Line Bonus PopUp for the Player +//----------- +Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); +var Cur: PScorePopUp; +begin + if (PlayerIndex < PlayerCount) then + begin + //Get Memory and Add Data + GetMem(Cur, SizeOf(TScorePopUp)); + + Cur.Player := PlayerIndex; + Cur.TimeStamp := SDL_GetTicks; + Cur.Rating := Rating; + Cur.ScoreGiven:= 0; + If (Players[PlayerIndex].Score < Score) then + begin + Cur.ScoreDiff := Score - Players[PlayerIndex].Score; + aPlayers[PlayerIndex].Score := Score; + end + else + Cur.ScoreDiff := 0; + Cur.Next := nil; + + //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); + + //Add it to the Chain + if (FirstPopUp = nil) then + //the first PopUp in the List + FirstPopUp := Cur + else + //second or earlier popup + LastPopUp.Next := Cur; + + //Set new Popup to Last PopUp in the List + LastPopUp := Cur; + end + else + Log.LogError('TSingScores: Try to add PopUp for not existing player'); +end; + +//----------- +// Removes a PopUp w/o destroying the List +//----------- +Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +var + lTempA , + lTempB : real; +begin + //Give Player the Last Points that missing till now + aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; + + //Change Bars Position + + // TODO : JB_Lazarus - Exception=Invalid floating point operation + // AT THIS LINE ! + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); + writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); + writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); + writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); + writeln( '' ); +*) + {$ENDIF} + + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); + writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); + writeln( '----------------------------------------------------------' ); +*) + {$ENDIF} + + if ( lTempA > 0 ) AND + ( lTempB > 0 ) THEN + begin + aPlayers[Cur.Player].RBTarget := lTempA / lTempB; + end; + + If (aPlayers[Cur.Player].RBTarget > 1) then + aPlayers[Cur.Player].RBTarget := 1 + else + If (aPlayers[Cur.Player].RBTarget < 0) then + aPlayers[Cur.Player].RBTarget := 0; + + //If this is the First PopUp => Make Next PopUp the First + If (Cur = FirstPopUp) then + FirstPopUp := Cur.Next + //Else => Remove Curent Popup from Chain + else + Last.Next := Cur.Next; + + //If this is the Last PopUp, Make PopUp before the Last + If (Cur = LastPopUp) then + LastPopUp := Last; + + //Free the Memory + FreeMem(Cur, SizeOf(TScorePopUp)); +end; + +//----------- +//Removes all PopUps from Mem +//----------- +Procedure TSingScores.KillAllPopUps; +var + Cur: PScorePopUp; + Last: PScorePopUp; +begin + Cur := FirstPopUp; + + //Remove all PopUps: + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TScorePopUp)); + end; + + FirstPopUp := nil; + LastPopUp := nil; +end; + +//----------- +//Init - has to be called after Positions and Players have been added, before first call of Draw +//It gives every Player a Score Position +//----------- +Procedure TSingScores.Init; +var + PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen + I, J: Integer; + MaxPlayersperScreen: Byte; + CurPlayer: Byte; + + Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; + var I: Integer; + begin + Result := 0; + bPlayerCount := 1 shl (bPlayerCount - 1); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + Inc(Result); + end; + end; + + Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; + var I: Integer; + begin + bPlayerCount := 1 shl (bPlayerCount - 1); + Result := High(Byte); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + begin + If (bPlayer = 0) then + begin + Result := I; + Break; + end + else + Dec(bPlayer); + end; + end; + end; + +begin + + For I := 1 to 6 do + begin + //If there are enough Positions -> Write to MaxPlayers + If (GetPositionCountbyPlayerCount(I) = I) then + MaxPlayersperScreen := I + else + Break; + end; + + + //Split Players to both Screen or Display on One Screen + if (Screens = 2) and (MaxPlayersperScreen < PlayerCount) then + begin + PlC[0] := PlayerCount div 2 + PlayerCount mod 2; + PlC[1] := PlayerCount div 2; + end + else + begin + PlC[0] := PlayerCount; + PlC[1] := 0; + end; + + + //Check if there are enough Positions for all Players + For I := 0 to Screens - 1 do + begin + if (PlC[I] > MaxPlayersperScreen) then + begin + PlC[I] := MaxPlayersperScreen; + Log.LogError('More Players than available Positions, TSingScores'); + end; + end; + + CurPlayer := 0; + //Give every Player a Position + For I := 0 to Screens - 1 do + For J := 0 to PlC[I]-1 do + begin + aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); + //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); + Inc(CurPlayer); + end; +end; + +//----------- +//Procedure Draws Scores and Linebonus PopUps +//----------- +Procedure TSingScores.Draw; +var + I: Integer; + CurTime: Cardinal; + CurPopUp, LastPopUp: PScorePopUp; +begin + CurTime := SDL_GetTicks; + + If Visible then + begin + //Draw Popups + LastPopUp := nil; + CurPopUp := FirstPopUp; + + While (CurPopUp <> nil) do + begin + if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + begin + KillPopUp(LastPopUp, CurPopUp); + if (LastPopUp = nil) then + CurPopUp := FirstPopUp + else + CurPopUp := LastPopUp.Next; + end + else + begin + DrawPopUp(CurPopUp); + LastPopUp := CurPopUp; + CurPopUp := LastPopUp.Next; + end; + end; + + + IF (RBVisible) then + //Draw Players w/ Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + DrawRatingBar(I); + end + else + //Draw Players w/o Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + end; + + end; //eo Visible +end; + +//----------- +//Procedure Draws a Popup by Pointer +//----------- +Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); +var + Progress: Real; + CurTime: Cardinal; + X, Y, W, H, Alpha: Real; + FontSize: Byte; + TimeDiff: Cardinal; + PIndex: Byte; + TextLen: Real; + ScoretoAdd: Word; + PosDiff: Real; +begin + if (PopUp <> nil) then + begin + //Only Draw if Player has a Position + PIndex := Players[PopUp.Player].Position; + If PIndex <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then + begin + CurTime := SDL_GetTicks; + If Not (Enabled AND Players[PopUp.Player].Enabled) then + //Increase Timestamp with TIem where there is no Movement ... + begin + //Inc(PopUp.TimeStamp, LastRender); + end; + TimeDiff := CurTime - PopUp.TimeStamp; + + //Get Position of PopUp + PIndex := PIndex AND 127; + + + //Check for Phase ... + If (TimeDiff <= Settings.Phase1Time) then + begin + //Phase 1 - The Ploping up + Progress := TimeDiff / Settings.Phase1Time; + + + W := Positions[PIndex].PUW * Sin(Progress/2*Pi); + H := Positions[PIndex].PUH * Sin(Progress/2*Pi); + + X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; + Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; + + FontSize := Round(Progress * Positions[PIndex].PUFontSize); + Alpha := 1; + end + + Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then + begin + //Phase 2 - The Moving + Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If PosDiff > 0 then + PosDiff := PosDiff + W; + X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If PosDiff < 0 then + PosDiff := PosDiff + Positions[PIndex].BGH; + Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); + + FontSize := Positions[PIndex].PUFontSize; + Alpha := 1 - 0.3 * Progress; + end + + else + begin + //Phase 3 - The Fading out + Score adding + Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; + + If (PopUp.Rating > 0) then + begin + //Add Scores if Player Enabled + If (Enabled AND Players[PopUp.Player].Enabled) then + begin + ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; + Inc(PopUp.ScoreGiven, ScoreToAdd); + aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + + //Change Bars Position + aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); + If (aPlayers[PopUp.Player].RBTarget > 1) then + aPlayers[PopUp.Player].RBTarget := 1 + else If (aPlayers[PopUp.Player].RBTarget < 0) then + aPlayers[PopUp.Player].RBTarget := 0; + end; + + //Set Positions etc. + Alpha := 0.7 - 0.7 * Progress; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If (PosDiff > 0) then + PosDiff := W + else + PosDiff := 0; + X := Positions[PIndex].PUTargetX + PosDiff * Progress; + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If (PosDiff < 0) then + PosDiff := -Positions[PIndex].BGH + else + PosDiff := 0; + Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); + + FontSize := Positions[PIndex].PUFontSize; + end + else + begin + //Here the Effect that Should be shown if a PopUp without Score is Drawn + //And or Spawn with the GraphicObjects etc. + //Some Work for Blindy to do :P + + //ATM: Just Let it Slide in the Scores just like the Normal PopUp + Alpha := 0; + end; + end; + + //Draw PopUp + + if (Alpha > 0) AND (Players[PopUp.Player].Visible) then + begin + //Draw BG: + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, Alpha); + glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Set FontStyle and Size + SetFontStyle(Positions[PIndex].PUFont); + SetFontItalic(False); + SetFontSize(FontSize); + + //Draw Text + TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + + //Color and Pos + SetFontPos (X + (W - TextLen) / 2, Y + 12); + glColor4f(1, 1, 1, Alpha); + + //Draw + glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + end; //eo Alpha check + end; //eo Right Screen + end; //eo Player has Position + end + else + Log.LogError('TSingScores: Try to Draw a not existing PopUp'); +end; + +//----------- +//Procedure Draws a Score by Playerindex +//----------- +Procedure TSingScores.DrawScore(const Index: Integer); +var + Position: PScorePosition; + ScoreStr: String; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then + begin + Position := @Positions[Players[Index].Position and 127]; + + //Draw ScoreBG + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, 1); + glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); + glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Draw Score Text + SetFontStyle(Position.TextFont); + SetFontItalic(False); + SetFontSize(Position.TextSize); + SetFontPos(Position.TextX, Position.TextY); + + ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; + While (Length(ScoreStr) < 5) do + ScoreStr := '0' + ScoreStr; + + glPrint(PChar(ScoreStr)); + + end; //eo Right Screen + end; //eo Player has Position +end; + + +Procedure TSingScores.DrawRatingBar(const Index: Integer); +var + Position: PScorePosition; + R,G,B, Size: Real; + Diff: Real; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) AND (Players[index].RBVisible AND Players[index].Visible) then + begin + Position := @Positions[Players[Index].Position and 127]; + + If (Enabled AND Players[Index].Enabled) then + begin + //Move Position if Enabled + Diff := Players[Index].RBTarget - Players[Index].RBPos; + If(Abs(Diff) < 0.02) then + aPlayers[Index].RBPos := aPlayers[Index].RBTarget + else + aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; + end; + + //Get Colors for RatingBar + If Players[index].RBPos <=0.22 then + begin + R := 1; + G := 0; + B := 0; + end + Else If Players[index].RBPos <=0.42 then + begin + R := 1; + G := Players[index].RBPos*5; + B := 0; + end + Else If Players[index].RBPos <=0.57 then + begin + R := 1; + G := 1; + B := 0; + end + Else If Players[index].RBPos <=0.77 then + begin + R := 1-(Players[index].RBPos-0.57)*5; + G := 1; + B := 0; + end + else + begin + R := 0; + G := 1; + B := 0; + end; + + //Enable all glFuncs Needed + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //Draw RatingBar BG + glColor4f(1, 1, 1, 0.8); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); + glVertex2f(Position.RBX+Position.RBW, Position.RBY); + glEnd; + + //Draw Rating bar itself + Size := Position.RBX + Position.RBW * Players[Index].RBPos; + glColor4f(R, G, B, 1); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Size, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); + glVertex2f(Size, Position.RBY); + glEnd; + + //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) + glColor4f(1, 1, 1, 0.6); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); + glVertex2f(Position.RBX + Position.RBW, Position.RBY); + glEnd; + + //Disable all Enabled glFuncs + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end; //eo Right Screen + end; //eo Player has Position +end; + +end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 5bab885b..2237c22a 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -2,6 +2,10 @@ unit USkins; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} type diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 9e0d6ca5..614363c8 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -2,6 +2,10 @@ unit USongs; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses SysUtils, @@ -225,8 +229,10 @@ begin ADirent := ReadDir(TheDir); if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.name ) > -1 ) then + ( pos( '.txt', ADirent^.name ) > 0 ) then begin + writeln ('***** FOUND TXT' + ADirent^.name ); + SLen := BrowsePos; Song[SLen].Path := Dir; @@ -244,7 +250,6 @@ begin //Change Length Only every 50 Entrys Inc(BrowsePos); - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then begin SetLength(Song, Length(Song) + 50); diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 76d78f5b..f1f7fe47 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -17,6 +17,10 @@ unit UTexture; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses OpenGL12, diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index c27f9c9e..c212e7cb 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -2,6 +2,10 @@ unit UThemes; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index f714fed5..3b7749a2 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -2,6 +2,9 @@ unit UTime; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} {$I switches.inc} {$UNDEF DebugDisplay} diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index c18eea6c..65dbc0a2 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -14,12 +14,16 @@ unit UVideo; //{$define DebugFrames} //{$define Info} -//{$define FFMpegAudio} +// {$define FFMpegAudio} {} interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} (* @@ -281,6 +285,7 @@ begin else if (AVPacket.stream_index = AudioStreamIndex ) then begin + writeln('Encue Audio packet'); UAudio_FFMpeg.packet_queue_put(UAudio_FFMpeg.audioq, AVPacket); {$endif} end; diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 55c89878..0fe5d51a 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -8,6 +8,10 @@ unit UPluginLoader; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UPluginDefs, UCoreModule; -- cgit v1.2.3 From 9d7f4c06634799c4582b2908673b55ea9fe96e61 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 2 Nov 2007 07:08:07 +0000 Subject: basic threading of song loading.. with some stubs for event based song list reloading. so songs can be added while the game is being played, potentially. and startup isnt slowed down by loading all the songs, as its done in the background. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@549 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 548 +++++++++++++++++++++---------------------- Game/Code/Classes/USongs.pas | 153 +++++++++--- 2 files changed, 396 insertions(+), 305 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index d3b65e2f..d7ae51f4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -152,314 +152,306 @@ var hWnd: THandle; I: Integer; begin - WndTitle := Version; + try -// InitializeSound(); -// writeln( 'DONE' ); -// exit; + WndTitle := Version; - - {$IFDEF MSWINDOWS} - //------------------------------ - //Start more than One Time Prevention - //------------------------------ - 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 + {$IFDEF MSWINDOWS} + //------------------------------ + //Start more than One Time Prevention + //------------------------------ + hWnd:= FindWindow(nil, PChar(WndTitle)); + //Programm already started + if (hWnd <> 0) then begin - I := 1; - repeat - Inc(I); - hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I))); - until (hWnd = 0); - WndTitle := WndTitle + ' Instance ' + InttoStr(I); - end + 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 + Exit; + end; + {$ENDIF} + + //------------------------------ + //StartUp - Create Classes and Load Files + //------------------------------ + USTime := TTime.Create; + + // Commandline Parameter Parser + Params := TCMDParams.Create; + + // Log + Benchmark + Log := TLog.Create; + Log.Title := WndTitle; + Log.Enabled := Not Params.NoLog; + Log.BenchmarkStart(0); + + // Language + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Paths', 'Initialization'); + InitializePaths; + Log.LogStatus('Load Language', 'Initialization'); + Language := TLanguage.Create; + //Add Const Values: + Language.AddConst('US_VERSION', Version); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Language', 1); + + // SDL + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL', 'Initialization'); + SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL', 1); + + // SDL_ttf + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL_ttf', 'Initialization'); + TTF_Init(); //ttf_quit(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL_ttf', 1); + + // Skin + Log.BenchmarkStart(1); + Log.LogStatus('Loading Skin List', 'Initialization'); + Skin := TSkin.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Skin List', 1); + + // Sound Card List + Log.BenchmarkStart(1); + Log.LogStatus('Loading Soundcard list', 'Initialization'); + Recording := TRecord.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Soundcard list', 1); + + // Ini + Paths + Log.BenchmarkStart(1); + Log.LogStatus('Load Ini', 'Initialization'); + Ini := TIni.Create; + Ini.Load; + + //Load Languagefile + if (Params.Language <> -1) then + Language.ChangeLanguage(ILanguage[Params.Language]) else - Exit; - end; - {$ENDIF} - - //------------------------------ - //StartUp - Create Classes and Load Files - //------------------------------ - USTime := TTime.Create; - - // Commandline Parameter Parser - Params := TCMDParams.Create; - - // Log + Benchmark - Log := TLog.Create; - Log.Title := WndTitle; - Log.Enabled := Not Params.NoLog; - Log.BenchmarkStart(0); - - // Language - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Paths', 'Initialization'); - InitializePaths; - Log.LogStatus('Load Language', 'Initialization'); - Language := TLanguage.Create; - //Add Const Values: - Language.AddConst('US_VERSION', Version); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Language', 1); - - // SDL - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL', 'Initialization'); - SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL', 1); - - // SDL_ttf - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL_ttf', 'Initialization'); - TTF_Init(); //ttf_quit(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL_ttf', 1); - - // Skin - Log.BenchmarkStart(1); - Log.LogStatus('Loading Skin List', 'Initialization'); - Skin := TSkin.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Skin List', 1); - - // Sound Card List - Log.BenchmarkStart(1); - Log.LogStatus('Loading Soundcard list', 'Initialization'); - Recording := TRecord.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Soundcard list', 1); - - // Ini + Paths - Log.BenchmarkStart(1); - Log.LogStatus('Load Ini', 'Initialization'); - Ini := TIni.Create; - Ini.Load; - - //Load Languagefile - if (Params.Language <> -1) then - Language.ChangeLanguage(ILanguage[Params.Language]) - else - Language.ChangeLanguage(ILanguage[Ini.Language]); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Ini', 1); - - - // LCD - Log.BenchmarkStart(1); - Log.LogStatus('Load LCD', 'Initialization'); - LCD := TLCD.Create; - if Ini.LPT = 1 then begin -// LCD.HalfInterface := true; - LCD.Enable; - LCD.Clear; - LCD.WriteText(1, ' UltraStar '); - LCD.WriteText(2, ' Loading... '); - end; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading LCD', 1); - - // Light - Log.BenchmarkStart(1); - Log.LogStatus('Load Light', 'Initialization'); - Light := TLight.Create; - if Ini.LPT = 2 then begin - Light.Enable; - end; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Light', 1); - - - - // Theme - Log.BenchmarkStart(1); - Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create('Themes\' + ITheme[Ini.Theme] + '.ini', Ini.Color); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Themes', 1); - - // Covers Cache - Log.BenchmarkStart(1); - Log.LogStatus('Creating Covers Cache', 'Initialization'); - Covers := TCovers.Create; - Log.LogBenchmark('Loading Covers Cache Array', 1); - Log.BenchmarkStart(1); - - // Category Covers - Log.BenchmarkStart(1); - Log.LogStatus('Creating Category Covers Array', 'Initialization'); - CatCovers:= TCatCovers.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Category Covers Array', 1); - - // Songs - //Log.BenchmarkStart(1); - Log.LogStatus('Creating Song Array', 'Initialization'); - Songs := TSongs.Create; - Songs.LoadSongList; - Log.LogStatus('Creating 2nd Song Array', 'Initialization'); - CatSongs := TCatSongs.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Songs', 1); - - // PluginManager - Log.BenchmarkStart(1); - Log.LogStatus('PluginManager', 'Initialization'); - DLLMan := TDLLMan.Create; //Load PluginList - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PluginManager', 1); - - // Party Mode Manager - Log.BenchmarkStart(1); - Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TParty_Session.Create; //Load PartySession - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); - - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - InitializeSound(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 1); - -// exit; - - // Graphics - Log.BenchmarkStart(1); - Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WndTitle); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing 3D', 1); - - // Score Saving System - Log.BenchmarkStart(1); - Log.LogStatus('DataBase System', 'Initialization'); - DataBase := TDataBaseSystem.Create; - - if (Params.ScoreFile = '') then - DataBase.Init ('Ultrastar.db') - else - DataBase.Init (Params.ScoreFile); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading DataBase System', 1); - - //Playlist Manager - Log.BenchmarkStart(1); - Log.LogStatus('Playlist Manager', 'Initialization'); - PlaylistMan := TPlaylistManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Playlist Manager', 1); - - //GoldenStarsTwinkleMod - Log.BenchmarkStart(1); - Log.LogStatus('Effect Manager', 'Initialization'); - GoldenRec := TEffectManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Particel System', 1); - - // Joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then begin + Language.ChangeLanguage(ILanguage[Ini.Language]); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Ini', 1); + + + // LCD Log.BenchmarkStart(1); - Log.LogStatus('Initialize Joystick', 'Initialization'); - Joy := TJoy.Create; + Log.LogStatus('Load LCD', 'Initialization'); + LCD := TLCD.Create; + if Ini.LPT = 1 then begin + // LCD.HalfInterface := true; + LCD.Enable; + LCD.Clear; + LCD.WriteText(1, ' UltraStar '); + LCD.WriteText(2, ' Loading... '); + end; Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Joystick', 1); - end; + Log.LogBenchmark('Loading LCD', 1); - Log.BenchmarkEnd(0); - Log.LogBenchmark('Loading Time', 0); + // Light + Log.BenchmarkStart(1); + Log.LogStatus('Load Light', 'Initialization'); + Light := TLight.Create; + if Ini.LPT = 2 then begin + Light.Enable; + end; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Light', 1); - Log.LogError('Creating Core'); - Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0))); - Log.LogError('Running Core'); - Core.Run; - //------------------------------ - //Start- Mainloop - //------------------------------ - //Music.SetLoop(true); - //Music.SetVolume(50); - //Music.Open(SkinPath + 'Menu Music 3.mp3'); - //Music.Play; - Log.LogStatus('Main Loop', 'Initialization'); - MainLoop; + // Theme + Log.BenchmarkStart(1); + Log.LogStatus('Load Themes', 'Initialization'); + Theme := TTheme.Create('Themes\' + ITheme[Ini.Theme] + '.ini', Ini.Color); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Themes', 1); - //------------------------------ - //Finish Application - //------------------------------ - if Ini.LPT = 1 then LCD.Clear; - if Ini.LPT = 2 then Light.TurnOff; + // Covers Cache + Log.BenchmarkStart(1); + Log.LogStatus('Creating Covers Cache', 'Initialization'); + Covers := TCovers.Create; + Log.LogBenchmark('Loading Covers Cache Array', 1); + Log.BenchmarkStart(1); - Log.LogStatus('Main Loop', 'Finished'); + // Category Covers + Log.BenchmarkStart(1); + Log.LogStatus('Creating Category Covers Array', 'Initialization'); + CatCovers:= TCatCovers.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Category Covers Array', 1); - Log.Free; + // Songs + //Log.BenchmarkStart(1); + Log.LogStatus('Creating Song Array', 'Initialization'); + Songs := TSongs.Create; +// Songs.LoadSongList; + Log.LogStatus('Creating 2nd Song Array', 'Initialization'); + CatSongs := TCatSongs.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Songs', 1); + + // PluginManager + Log.BenchmarkStart(1); + Log.LogStatus('PluginManager', 'Initialization'); + DLLMan := TDLLMan.Create; //Load PluginList + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PluginManager', 1); + + // Party Mode Manager + Log.BenchmarkStart(1); + Log.LogStatus('PartySession Manager', 'Initialization'); + PartySession := TParty_Session.Create; //Load PartySession + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PartySession Manager', 1); + + // Sound + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + + // exit; + + // Graphics + Log.BenchmarkStart(1); + Log.LogStatus('Initialize 3D', 'Initialization'); + Initialize3D(WndTitle); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing 3D', 1); + + // Score Saving System + Log.BenchmarkStart(1); + Log.LogStatus('DataBase System', 'Initialization'); + DataBase := TDataBaseSystem.Create; + + if (Params.ScoreFile = '') then + DataBase.Init ('Ultrastar.db') + else + DataBase.Init (Params.ScoreFile); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading DataBase System', 1); + + //Playlist Manager + Log.BenchmarkStart(1); + Log.LogStatus('Playlist Manager', 'Initialization'); + PlaylistMan := TPlaylistManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Playlist Manager', 1); + + //GoldenStarsTwinkleMod + Log.BenchmarkStart(1); + Log.LogStatus('Effect Manager', 'Initialization'); + GoldenRec := TEffectManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Particel System', 1); + + // Joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + begin + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Joystick', 'Initialization'); + Joy := TJoy.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Joystick', 1); + end; + + Log.BenchmarkEnd(0); + Log.LogBenchmark('Loading Time', 0); + + Log.LogError('Creating Core'); + Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0))); + + Log.LogError('Running Core'); + Core.Run; + + //------------------------------ + //Start- Mainloop + //------------------------------ + //Music.SetLoop(true); + //Music.SetVolume(50); + //Music.Open(SkinPath + 'Menu Music 3.mp3'); + //Music.Play; + Log.LogStatus('Main Loop', 'Initialization'); + MainLoop; + + finally + //------------------------------ + //Finish Application + //------------------------------ + if Ini.LPT = 1 then LCD.Clear; + if Ini.LPT = 2 then Light.TurnOff; + + Log.LogStatus('Main Loop', 'Finished'); + Log.Free; + end; end; -//{$ENDIF} procedure MainLoop; var Delay: integer; begin - Delay := 0; - SDL_EnableKeyRepeat(125, 125); - - - CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - While not Done do - Begin - // joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - Joy.Update; + try + Delay := 0; + SDL_EnableKeyRepeat(125, 125); - // keyboard events - CheckEvents; + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. + While not Done do + Begin + // joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + Joy.Update; - // display - done := not Display.Draw; - SwapBuffers; + // keyboard events + CheckEvents; - // light - Light.Refresh; + // display + done := not Display.Draw; + SwapBuffers; - // delay - CountMidTime; - - {$IFDEF DebugDisplay} - Writeln( 'TimeMid : '+ inttostr(trunc(TimeMid)) ); - {$ENDIF} + // light + Light.Refresh; -// if 1000*TimeMid > 100 then beep; - Delay := Floor(1000 / 100 - 1000 * TimeMid); + // delay + CountMidTime; - {$IFDEF DebugDisplay} - Writeln( 'Delay ms : '+ inttostr(Delay) ); - {$ENDIF} + Delay := Floor(1000 / 100 - 1000 * TimeMid); - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps - CountSkipTime; + CountSkipTime; - // reinitialization of graphics - if Restart then - begin - Reinitialize3D; - Restart := false; - end; + // reinitialization of graphics + if Restart then + begin + Reinitialize3D; + Restart := false; + end; - End; - UnloadOpenGL; + End; + + finally + UnloadOpenGL; + end; End; Procedure CheckEvents; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 614363c8..e3b2f3b2 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -10,12 +10,16 @@ interface uses SysUtils, {$ifndef MSWINDOWS} - {$IFDEF DARWIN} + {$IFDEF DARWIN} baseunix, {$ELSE} - oldlinux, - {$ENDIF} + oldlinux, + {$ENDIF} + baseunix, + UnixType, + syscall, {$endif} + Classes, ULog, UTexture, UCommon, @@ -57,7 +61,7 @@ type Background: widestring; Video: widestring; VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded NotesGAP: integer; Start: real; // in seconds Finish: integer; // in miliseconds @@ -76,16 +80,25 @@ type CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs end; - TSongs = class + TSongs = class( TThread ) private - BrowsePos: Cardinal; //Actual Pos in Song Array + BrowsePos : Cardinal; //Actual Pos in Song Array + fNotify , + fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + procedure int_LoadSongList; + protected + procedure Execute; override; public - Song: array of TSong; // array of songs - Selected: integer; // selected song index - procedure LoadSongList; // load all songs + Song : array of TSong; // array of songs + Selected : integer; // selected song index + constructor create(); + procedure LoadSongList; // load all songs procedure BrowseDir(Dir: widestring); // should return number of songs in the future procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; end; TCatSongs = class @@ -113,6 +126,20 @@ var CatSongs: TCatSongs; // categorized songs AktSong: TSong; // one song *unknown use) +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + implementation uses StrUtils, @@ -127,22 +154,94 @@ begin end; {$ENDIF} -procedure TSongs.LoadSongList; +constructor TSongs.create(); begin - Log.LogStatus('Initializing', 'LoadSongList'); + inherited create( false ); + self.freeonterminate := true; + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + Setlength(Song, 0); +end; - // clear - Setlength(Song, 50); +procedure TSongs.Execute(); +var - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); + lrfds : fdSet; + time : Ttimeval; + res : integer; + buf : pchar; + len, bufflen : longint; + str : String; +begin + fParseSongDirectory := true; - //Set Correct SongArray Length - SetLength(Song, BrowsePos); -// if Ini.Debug = 1 then BrowseDir('D:\Extract\Songs\'); + while not self.terminated do + begin + +// if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; + +end; + +procedure TSongs.int_LoadSongList; +begin + try + fProcessing := true; + + Log.LogError('SongList', 'Searching For Songs'); + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); + finally + Log.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; end; +// TODO : JB - THis whole function SUX ! and needs refactoring ! :P procedure TSongs.BrowseDir(Dir: widestring); var SLen: integer; @@ -150,10 +249,10 @@ var {$ifdef MSWINDOWS} SR: TSearchRecW; // for parsing Songs Directory {$else} // This should work on all posix systems. - TheDir : pdir; - ADirent : pDirent; + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; Entry : Longint; - info : stat; + info : oldlinux.stat; {$endif} begin {$ifdef MSWINDOWS} @@ -201,11 +300,11 @@ begin {$IFDEF LINUX} // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := opendir( Dir ); // JB_Unicode - linux + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux if TheDir <> nil then begin repeat - ADirent := ReadDir(TheDir); + ADirent := oldlinux.ReadDir(TheDir); If ADirent<>Nil then begin @@ -222,11 +321,11 @@ begin - TheDir := opendir( Dir ); // JB_Unicode - linux + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux if TheDir <> nil then begin repeat - ADirent := ReadDir(TheDir); + ADirent := oldlinux.ReadDir(TheDir); if ( ADirent <> Nil ) AND ( pos( '.txt', ADirent^.name ) > 0 ) then -- cgit v1.2.3 From fd6d416f75bc316dca4356b5b8e5c7e317d1f156 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 2 Nov 2007 07:15:11 +0000 Subject: fix bad build#USDX-DELPHI-99 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@550 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index e3b2f3b2..6a58a8dd 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -187,14 +187,15 @@ begin end; procedure TSongs.Execute(); +(* var - lrfds : fdSet; time : Ttimeval; res : integer; buf : pchar; len, bufflen : longint; str : String; +*) begin fParseSongDirectory := true; @@ -218,6 +219,7 @@ begin fProcessing := true; Log.LogError('SongList', 'Searching For Songs'); + Setlength(Song, 50); BrowsePos := 0; -- cgit v1.2.3 From 35b7a40253bd38d1e1df8469d4151e99f9978850 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 2 Nov 2007 11:14:33 +0000 Subject: Runtime theme changing - jira#USDX-156 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@552 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index bfad2d73..e13fdf43 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -230,6 +230,7 @@ procedure LoadTextures; procedure InitializeScreen; procedure LoadLoadingScreen; procedure LoadScreens; +procedure UnLoadScreens; function LoadingThreadFunction: integer; @@ -692,7 +693,7 @@ begin ScreenCredits := TScreenCredits.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - end; +end; function LoadingThreadFunction: integer; begin @@ -700,4 +701,40 @@ begin Result:= 1; end; +procedure UnLoadScreens; +begin + freeandnil( ScreenMain ); + freeandnil( ScreenName ); + freeandnil( ScreenLevel); + freeandnil( ScreenSong ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSing ); + freeandnil( ScreenScore); + freeandnil( ScreenTop5 ); + freeandnil( ScreenOptions ); + freeandnil( ScreenOptionsGame ); + freeandnil( ScreenOptionsGraphics ); + freeandnil( ScreenOptionsSound ); + freeandnil( ScreenOptionsLyrics ); +// freeandnil( ScreenOptionsThemes ); + freeandnil( ScreenOptionsRecord ); + freeandnil( ScreenOptionsAdvanced ); + freeandnil( ScreenEditSub ); + freeandnil( ScreenEdit ); + freeandnil( ScreenEditConvert ); + freeandnil( ScreenOpen ); + freeandnil( ScreenSingModi ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSongJumpto); + freeandnil( ScreenPopupCheck ); + freeandnil( ScreenPopupError ); + freeandnil( ScreenPartyNewRound ); + freeandnil( ScreenPartyScore ); + freeandnil( ScreenPartyWin ); + freeandnil( ScreenPartyOptions ); + freeandnil( ScreenPartyPlayer ); + freeandnil( ScreenStatMain ); + freeandnil( ScreenStatDetail ); +end; + end. -- cgit v1.2.3 From ae057627ff135d55891e9f04f399608fbc47e9ee Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 2 Nov 2007 12:16:50 +0000 Subject: Runtime Song Addition jira:USDX-157 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@553 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 1 - Game/Code/Classes/UCatCovers.pas | 2 +- Game/Code/Classes/UMain.pas | 1 + Game/Code/Classes/USongs.pas | 66 ++++++++++++++++++++++++++++--------- 4 files changed, 52 insertions(+), 18 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index afbb23c1..b89fa00f 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -380,7 +380,6 @@ end; procedure TAudio_ffMpeg.PlayStart; begin - // LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); // TODO : jb_linux replace with something other than bass diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas index b1c91e48..516544be 100644 --- a/Game/Code/Classes/UCatCovers.pas +++ b/Game/Code/Classes/UCatCovers.pas @@ -49,7 +49,7 @@ var Name, Filename, Temp: string; begin try - Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); + Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); List := TStringlist.Create; //Add every Cover in Covers Ini for Every Sorting option diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index d7ae51f4..fa4c45b5 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -303,6 +303,7 @@ begin Log.LogStatus('Creating 2nd Song Array', 'Initialization'); CatSongs := TCatSongs.Create; + Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Songs', 1); diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 6a58a8dd..2eeeec87 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -8,17 +8,21 @@ interface {$I switches.inc} -uses SysUtils, +uses {$ifndef MSWINDOWS} - {$IFDEF DARWIN} - baseunix, - {$ELSE} - oldlinux, - {$ENDIF} + {$IFDEF DARWIN} + baseunix, + {$ELSE} + oldlinux, + {$ENDIF} baseunix, UnixType, syscall, + {$else} + windows, + DirWatch, {$endif} + SysUtils, Classes, ULog, UTexture, @@ -87,7 +91,11 @@ type fWatch : longint; fParseSongDirectory : boolean; fProcessing : boolean; + {$ifdef win32} + fDirWatch : TDirectoryWatch; + {$endif} procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); protected procedure Execute; override; public @@ -143,6 +151,8 @@ const implementation uses StrUtils, + UGraphic, + UCovers, UFiles, UMain, UIni; @@ -159,6 +169,14 @@ begin inherited create( false ); self.freeonterminate := true; + {$IFDEF Win32} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + {$IFDEF linux} (* Thankyou to : http://www.linuxjournal.com/article/8478 @@ -186,23 +204,21 @@ begin Setlength(Song, 0); end; +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + procedure TSongs.Execute(); -(* var - lrfds : fdSet; - time : Ttimeval; - res : integer; - buf : pchar; - len, bufflen : longint; - str : String; -*) + fChangeNotify : THandle; begin fParseSongDirectory := true; while not self.terminated do begin -// if fParseSongDirectory then + if fParseSongDirectory then begin writeln( 'int_LoadSongList' ); int_LoadSongList(); @@ -217,7 +233,8 @@ procedure TSongs.int_LoadSongList; begin try fProcessing := true; - + Setlength(Song, 0); + Log.LogError('SongList', 'Searching For Songs'); Setlength(Song, 50); @@ -228,6 +245,23 @@ begin //Set Correct SongArray Length SetLength(Song, BrowsePos); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + if assigned( Covers ) then + Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + finally Log.LogError('SongList', 'Search Complete'); -- cgit v1.2.3 From 7707816349d4bd2a14e9140e85c65f0bfd713718 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Fri, 2 Nov 2007 18:40:41 +0000 Subject: Fixed MacOSX version. Can we use baseunix on linux? We could drop oldlinux then (not available on the mac). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@555 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 1 - Game/Code/Classes/USongs.pas | 36 ++++++++++++++++++++++-------------- 2 files changed, 22 insertions(+), 15 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index fa4c45b5..e4acf4aa 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -145,7 +145,6 @@ uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, const Version = 'UltraStar Deluxe V 1.10 Alpha Build'; -//{$IFDEF WIN32} Procedure Main; var WndTitle: string; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 2eeeec87..7fd58034 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -9,19 +9,17 @@ interface {$I switches.inc} uses - {$ifndef MSWINDOWS} - {$IFDEF DARWIN} - baseunix, - {$ELSE} + {$IFDEF MSWINDOWS} + Windows, + DirWatch, + {$ELSE} + {$IFNDEF DARWIN} oldlinux, + syscall, {$ENDIF} baseunix, UnixType, - syscall, - {$else} - windows, - DirWatch, - {$endif} + {$ENDIF} SysUtils, Classes, ULog, @@ -91,7 +89,7 @@ type fWatch : longint; fParseSongDirectory : boolean; fProcessing : boolean; - {$ifdef win32} + {$ifdef MSWINDOWS} fDirWatch : TDirectoryWatch; {$endif} procedure int_LoadSongList; @@ -169,7 +167,7 @@ begin inherited create( false ); self.freeonterminate := true; - {$IFDEF Win32} + {$IFDEF MSWINDOWS} fDirWatch := TDirectoryWatch.create(nil); fDirWatch.OnChange := DoDirChanged; fDirWatch.Directory := SongPath; @@ -206,7 +204,7 @@ end; procedure TSongs.DoDirChanged(Sender: TObject); begin - LoadSongList(); + LoadSongList(); end; procedure TSongs.Execute(); @@ -284,12 +282,22 @@ var {$ifdef MSWINDOWS} SR: TSearchRecW; // for parsing Songs Directory - {$else} // This should work on all posix systems. + {$ENDIF} + + // eddie: can we merge that? is baseunix working on linux? oldlinux is + // not available on mac os x. + {$IFDEF LINUX} TheDir : oldlinux.pdir; ADirent : oldlinux.pDirent; Entry : Longint; info : oldlinux.stat; - {$endif} + {$ENDIF} + {$IFDEF DARWIN} + TheDir : pdir; + ADirent : pDirent; + Entry : Longint; + info : stat; + {$ENDIF} begin {$ifdef MSWINDOWS} if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows -- cgit v1.2.3 From 2a1be1865f68633a2385d8e55a6bd815616ec23f Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Fri, 2 Nov 2007 19:49:23 +0000 Subject: Fixed GamePath for Mac OS X. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@558 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index e4acf4aa..1be4b463 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1023,6 +1023,26 @@ begin Player[PlayerNum].ScoreTotalI := 0; end; +{$IFDEF DARWIN} +// Mac applications are packaged in directories. +// We have to cut the last two directories +// to get the application directory. +Function GetGamePath : String; +var + x, + i : integer; +begin + Result := ExtractFilePath(ParamStr(0)); + for x := 0 to 2 do begin + i := Length(Result); + repeat + Delete( Result, i, 1); + i := Length(Result); + until (i = 0) or (Result[i] = '/'); + end; +end; +{$ENDIF} + //-------------------- // Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist //-------------------- @@ -1057,7 +1077,11 @@ procedure InitializePaths; begin +{$IFDEF DARWIN} + GamePath := GetGamePath; +{$ELSE} GamePath := ExtractFilePath(ParamStr(0)); +{$ENDIF} initialize_path( LogPath , GamePath ); initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); -- cgit v1.2.3 From 8c9c787a1326b90490543bd50b56fce9b89d9807 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 3 Nov 2007 02:31:06 +0000 Subject: Windows Lazarus Build working again... Lazarus Project file includes the DPR, so that we have a unified Uses Clause ( keep this in mind please ) added "Delphi" to switches git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@560 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 603 +++++---- Game/Code/Classes/UCore.pas | 1002 +++++++-------- Game/Code/Classes/USongs.pas | 2088 ++++++++++++++++---------------- Game/Code/Classes/UTexture.pas | 2286 +++++++++++++++++------------------ Game/Code/Classes/uPluginLoader.pas | 1602 ++++++++++++------------ 5 files changed, 3791 insertions(+), 3790 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 43017aff..65d98e30 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,302 +1,301 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, -{$IFDEF LAZARUS} - lResources, -{$ENDIF} - ULog, -{$IFDEF DARWIN} - messages, -{$ENDIF} -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF LAZARUS} - function LazFindResource( const aName, aType : String ): TLResource; -{$ENDIF} - -{$IFDEF FPC} - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; - - {$IFDEF WIN32} - type - TWndMethod = procedure(var Message: TMessage) of object; - function AllocateHWnd(Method: TWndMethod): HWND; - procedure DeallocateHWnd(Wnd: HWND); - {$ENDIF} // Win32 - -{$ENDIF} // FPC Only - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -{$IFDEF MSWINDOWS} - -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; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; -{$endif} - -implementation - -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 win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -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} - - -{$IFDEF LAZARUS} - -function LazFindResource( const aName, aType : String ): TLResource; -var - iCount : Integer; -begin - result := nil; - - for iCount := 0 to LazarusResources.count -1 do - begin - if ( LazarusResources.items[ iCount ].Name = aName ) AND - ( LazarusResources.items[ iCount ].ValueType = aType ) THEN - begin - result := LazarusResources.items[ iCount ]; - exit; - end; - end; -end; -{$ENDIF} - -{$IFDEF FPC} -function MaxValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result < Data[I] then - Result := Data[I]; -end; - -function MinValue(const Data: array of Double): Double; -var - I: Integer; -begin - Result := Data[Low(Data)]; - for I := Low(Data) + 1 to High(Data) do - if Result > Data[I] then - Result := Data[I]; -end; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin -RandomRange := Random(aMax-aMin) + aMin ; -end; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{$IFDEF MSWINDOWS} -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -{$ENDIF} -{$IFDEF DARWIN} -// TODO : Situation for the mac isn't better ! -function AllocateHWnd(Method: TWndMethod): HWND; -begin -end; - -procedure DeallocateHWnd(Wnd: HWND); -begin -end; -{$ENDIF} - - - - -{$ENDIF} - -{$ifdef MSWINDOWS} -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; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - 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 - if FindNextFileW(F.FindHandle, F.FindData) then - 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 - if not FindNextFileW(FindHandle, FindData) then - 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; -{$endif} - - - - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, +{$IFDEF LAZARUS} + lResources, +{$ENDIF} + ULog, +{$IFDEF DARWIN} + messages, +{$ENDIF} +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF LAZARUS} + function LazFindResource( const aName, aType : String ): TLResource; +{$ENDIF} + +{$IFDEF FPC} + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + + {$IFDEF WIN32} + type + TWndMethod = procedure(var Message: TMessage) of object; + function AllocateHWnd(Method: TWndMethod): HWND; + procedure DeallocateHWnd(Wnd: HWND); + {$ENDIF} // Win32 + +{$ENDIF} // FPC Only + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +{$IFNDEF FPC} +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; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; +{$endif} + +implementation + +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 win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +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} + + +{$IFDEF LAZARUS} + +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; +{$ENDIF} + +{$IFDEF FPC} +function MaxValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result < Data[I] then + Result := Data[I]; +end; + +function MinValue(const Data: array of Double): Double; +var + I: Integer; +begin + Result := Data[Low(Data)]; + for I := Low(Data) + 1 to High(Data) do + if Result > Data[I] then + Result := Data[I]; +end; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin +RandomRange := Random(aMax-aMin) + aMin ; +end; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF MSWINDOWS} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} +{$IFDEF DARWIN} +// TODO : Situation for the mac isn't better ! +function AllocateHWnd(Method: TWndMethod): HWND; +begin +end; + +procedure DeallocateHWnd(Wnd: HWND); +begin +end; +{$ENDIF} + + + + +{$ENDIF} + +{$ifNdef FPC} +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; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + 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 + if FindNextFileW(F.FindHandle, F.FindData) then + 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 + if not FindNextFileW(FindHandle, FindData) then + 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; +{$endif} + + + + + +end. diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index acd9ead7..e0f9fec2 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -1,501 +1,501 @@ -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; - - //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 - - CurExecuted: Integer; //ID of Plugin or Module curently Executed - - 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 - - - //--------------- - //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook - Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook - Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 - Name := cName; - Version := cVersion; - CurExecuted := 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 - noError: Boolean; -begin - //Get Modules - Try - noError := GetModules; - Except - noError := False; - end; - - //Loading - if (noError) then - begin - Try - noError := Load; - Except - noError := False; - end; - - if (noError) then - begin //Init - Try - noError := Init; - Except - noError := False; - end; - - If noError then - begin - //Call Translate Hook - noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0); - - If noError then - begin //Calls LoadTextures Hook - noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0); - - if noError then - begin //Calls Loading Finished Hook - noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0); - - If noError then - begin - //Start MainLoop - While noError do - begin - noError := MainLoop; - // to-do : Call Display Draw here - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); - end; - - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); - end; - end - else - begin - If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) - else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); - end; - - //DeInit - DeInit; -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; - try - For I := 0 to high(Modules) do - begin - Modules[I].NeedsDeInit := False; - Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; - Modules[I].Module.Info(@Modules[I].Info); - end; - Result := True; - except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; -end; - -//------------- -//Loads Core and all Modules -//------------- -Function TCore.Load: Boolean; -var - I: Integer; -begin - Result := LoadCore; - - I := 0; - While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do - begin - try - Result := Modules[I].Module.Load; - except - Result := False; - ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; - - Inc(I); - end; -end; - -//------------- -//Inits Core and all Modules -//------------- -Function TCore.Init: Boolean; -var - I: Integer; -begin - Result := InitCore; - - I := 0; - While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do - begin - try - Result := Modules[I].Module.Init; - except - Result := False; - ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); - end; - - Modules[I].NeedsDeInit := Result; - Inc(I); - end; -end; - -//------------- -//DeInits Core and all Modules -//------------- -Function TCore.DeInit: Boolean; -var - I: Integer; -label Continue; -begin - I := High(CORE_MODULES_TO_LOAD); - - Continue: - Try - While (I >= 0) do - begin - If (Modules[I].NeedsDeInit) then - Modules[I].Module.DeInit; - - Dec(I); - end; - Except - - - end; - If (I >= 0) then - GoTo Continue; - - DeInitCore; -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); -end; - -//------------- -//Init the Core -//------------- -Function TCore.InitCore: Boolean; -begin - //Dont Init s.th. atm. -end; - -//------------- -//DeInit the Core -//------------- -Function TCore.DeInitCore: Boolean; -begin - - - // to-do : write TService-/HookManager.Free and call it here -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 - If (Modules[I].Info.Name = Name) then - begin - Result := @Modules[I].Module; - Break; - end; -end; - -//------------- -// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) -//------------- -Function TCore.ShowMessage(wParam, lParam: DWord): integer; -var Params: Cardinal; -begin - Result := -1; - - {$IFDEF MSWINDOWS} - If (ptr(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; - - //Anzeigen: - Result := Messagebox(0, ptr(lParam), PChar(Name), Params); - end; - {$ENDIF} - - // to-do : write ShowMessage for other OSes -end; - -//------------- -// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -Function TCore.ReportError(wParam, lParam: DWord): integer; -begin - //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(Pointer(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, lParam: DWord): integer; -begin - Hooks.CallEventChain(hDebug, wParam, lParam); -end; - -//------------- -// Calls Translate hook -//------------- -Function TCore.Retranslate(wParam, lParam: DWord): integer; -begin - Hooks.CallEventChain(hTranslate, 0, 1); -end; - -//------------- -// Calls LoadTextures hook -//------------- -Function TCore.ReloadTextures(wParam, lParam: DWord): integer; -begin - Hooks.CallEventChain(hLoadTextures, 0, 1); -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, lParam: DWord): 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, lParam: DWord): integer; -begin - Result := hInstance; -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; + + //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 + + CurExecuted: Integer; //ID of Plugin or Module curently Executed + + 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 + + + //--------------- + //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook + Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook + Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 + Name := cName; + Version := cVersion; + CurExecuted := 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 + noError: Boolean; +begin + //Get Modules + Try + noError := GetModules; + Except + noError := False; + end; + + //Loading + if (noError) then + begin + Try + noError := Load; + Except + noError := False; + end; + + if (noError) then + begin //Init + Try + noError := Init; + Except + noError := False; + end; + + If noError then + begin + //Call Translate Hook + noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0); + + If noError then + begin //Calls LoadTextures Hook + noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0); + + if noError then + begin //Calls Loading Finished Hook + noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0); + + If noError then + begin + //Start MainLoop + While noError do + begin + noError := MainLoop; + // to-do : Call Display Draw here + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); + end; + + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); + end; + end + else + begin + If (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) + else + Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); + end; + + //DeInit + DeInit; +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; + try + For I := 0 to high(Modules) do + begin + Modules[I].NeedsDeInit := False; + Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create; + Modules[I].Module.Info(@Modules[I].Info); + end; + Result := True; + except + ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; +end; + +//------------- +//Loads Core and all Modules +//------------- +Function TCore.Load: Boolean; +var + I: Integer; +begin + Result := LoadCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + try + Result := Modules[I].Module.Load; + except + Result := False; + ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + + Inc(I); + end; +end; + +//------------- +//Inits Core and all Modules +//------------- +Function TCore.Init: Boolean; +var + I: Integer; +begin + Result := InitCore; + + I := 0; + While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do + begin + try + Result := Modules[I].Module.Init; + except + Result := False; + ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + end; + + Modules[I].NeedsDeInit := Result; + Inc(I); + end; +end; + +//------------- +//DeInits Core and all Modules +//------------- +Function TCore.DeInit: Boolean; +var + I: Integer; +label Continue; +begin + I := High(CORE_MODULES_TO_LOAD); + + Continue: + Try + While (I >= 0) do + begin + If (Modules[I].NeedsDeInit) then + Modules[I].Module.DeInit; + + Dec(I); + end; + Except + + + end; + If (I >= 0) then + GoTo Continue; + + DeInitCore; +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); +end; + +//------------- +//Init the Core +//------------- +Function TCore.InitCore: Boolean; +begin + //Dont Init s.th. atm. +end; + +//------------- +//DeInit the Core +//------------- +Function TCore.DeInitCore: Boolean; +begin + + + // to-do : write TService-/HookManager.Free and call it here +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 + If (Modules[I].Info.Name = Name) then + begin + Result := @Modules[I].Module; + Break; + end; +end; + +//------------- +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +Function TCore.ShowMessage(wParam, lParam: DWord): integer; +var Params: Cardinal; +begin + Result := -1; + + {$IFDEF Delphi} + If (ptr(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; + + //Anzeigen: + Result := Messagebox(0, ptr(lParam), PChar(Name), Params); + end; + {$ENDIF} + + // to-do : write ShowMessage for other OSes +end; + +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +Function TCore.ReportError(wParam, lParam: DWord): integer; +begin + //Update LastErrorReporter and LastErrorString + LastErrorReporter := String(PChar(Pointer(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, lParam: DWord): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); +end; + +//------------- +// Calls Translate hook +//------------- +Function TCore.Retranslate(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hTranslate, 0, 1); +end; + +//------------- +// Calls LoadTextures hook +//------------- +Function TCore.ReloadTextures(wParam, lParam: DWord): integer; +begin + Hooks.CallEventChain(hLoadTextures, 0, 1); +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, lParam: DWord): 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, lParam: DWord): integer; +begin + Result := hInstance; +end; + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 7fd58034..2fa3ea4a 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,1043 +1,1045 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF MSWINDOWS} - Windows, - DirWatch, - {$ELSE} - {$IFNDEF DARWIN} - oldlinux, - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - ULog, - UTexture, - UCommon, - UCatCovers; - -type - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - TSong = record - Path: widestring; - Folder: widestring; // for sorting by folder - FileName: widestring; - - // sorting methods - Category: array of widestring; // I think I won't need this - Genre: widestring; - Edition: widestring; - Language: widestring; // 0.5.0: new - - Title: widestring; - Artist: widestring; - - Text: widestring; - Creator: widestring; - - Cover: widestring; - CoverTex: TTexture; - Mp3: widestring; - Background: widestring; - Video: widestring; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - - TSongs = class( TThread ) - private - BrowsePos : Cardinal; //Actual Pos in Song Array - fNotify , - fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; - {$ifdef MSWINDOWS} - fDirWatch : TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public - Song : array of TSong; // array of songs - Selected : integer; // selected song index - constructor create(); - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; - end; - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; - -{$IFDEF DARWIN} -function AnsiContainsText(const AText, ASubText: string): Boolean; -begin - Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; -end; -{$ENDIF} - -constructor TSongs.create(); -begin - inherited create( false ); - self.freeonterminate := true; - - {$IFDEF MSWINDOWS} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - {$IFDEF linux} - (* - Thankyou to : http://www.linuxjournal.com/article/8478 - http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch - *) -(* - fNotify := -1; - fWatch := -1; - - writeln( 'Calling inotify_init' ); - fNotify := Do_SysCall( syscall_nr_inotify_init ); - if ( fNotify < 0 ) then - writeln( 'Filesystem change notification - disabled' ); - writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); - - writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); - fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); - - if (fWatch < 0) then - writeln ('inotify_add_watch'); - writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); -*) - {$endif} - - Setlength(Song, 0); -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify : THandle; -begin - fParseSongDirectory := true; - - while not self.terminated do - begin - - if fParseSongDirectory then - begin - writeln( 'int_LoadSongList' ); - int_LoadSongList(); - end; - - self.suspend; - end; - -end; - -procedure TSongs.int_LoadSongList; -begin - try - fProcessing := true; - Setlength(Song, 0); - - Log.LogError('SongList', 'Searching For Songs'); - - Setlength(Song, 50); - - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); - - if assigned( CatSongs ) then - CatSongs.Refresh; - - if assigned( CatCovers ) then - CatCovers.Load; - - if assigned( Covers ) then - Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - - finally - Log.LogError('SongList', 'Search Complete'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - self.resume; -end; - -// TODO : JB - THis whole function SUX ! and needs refactoring ! :P -procedure TSongs.BrowseDir(Dir: widestring); -var - SLen: integer; - - {$ifdef MSWINDOWS} - SR: TSearchRecW; // for parsing Songs Directory - {$ENDIF} - - // eddie: can we merge that? is baseunix working on linux? oldlinux is - // not available on mac os x. - {$IFDEF LINUX} - TheDir : oldlinux.pdir; - ADirent : oldlinux.pDirent; - Entry : Longint; - info : oldlinux.stat; - {$ENDIF} - {$IFDEF DARWIN} - TheDir : pdir; - ADirent : pDirent; - Entry : Longint; - info : stat; - {$ENDIF} -begin - {$ifdef MSWINDOWS} - if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows - begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - begin - BrowseDir(Dir + Sr.Name + PathDelim); - end - until FindNextw(SR) <> 0; - end; // if - FindClosew(SR); - - if FindFirstW(Dir + '*.txt', 0, SR) = 0 then - begin - repeat - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNextW(SR) <> 0; - end; // if FindFirst - FindCloseW(SR); - {$ENDIF} - - {$IFDEF LINUX} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - If ADirent<>Nil then - begin - With ADirent^ do - begin - - if ( name[0] <> '.') then - BrowseDir( Dir + name + pathdelim ); - - end; - end; - Until ADirent=Nil; - end; - - - - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.name ) > 0 ) then - begin - writeln ('***** FOUND TXT' + ADirent^.name ); - - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst - {$endif} - - {$IFDEF DARWIN} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - If ADirent<>Nil then - begin - With ADirent^ do - begin - - if ( d_name[0] <> '.') then - BrowseDir( Dir + d_name + pathdelim ); - - end; - end; - Until ADirent=Nil; - end; - - - - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.d_name ) > -1 ) then - begin - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.d_name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst - - {$endif} - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := Low(Songs.Song) to High(Songs.Song) do begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := Songs.Song[S].Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := Songs.Song[S].Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := Songs.Song[S].Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and - (Length(Songs.Song[S].Title)>=1) and - (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := Uppercase(Songs.Song[S].Title)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := UpperCase(Songs.Song[S].Artist)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := Songs.Song[S].Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := Songs.Song[S]; - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ifdef Delphi} + DirWatch, + {$endif} + {$ELSE} + {$IFNDEF DARWIN} + oldlinux, + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + ULog, + UTexture, + UCommon, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + TSong = record + Path: widestring; + Folder: widestring; // for sorting by folder + FileName: widestring; + + // sorting methods + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new + + Title: widestring; + Artist: widestring; + + Text: widestring; + Creator: widestring; + + Cover: widestring; + CoverTex: TTexture; + Mp3: widestring; + Background: widestring; + Video: widestring; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class( TThread ) + private + BrowsePos : Cardinal; //Actual Pos in Song Array + fNotify , + fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef Delphi} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public + Song : array of TSong; // array of songs + Selected : integer; // selected song index + constructor create(); + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} + +constructor TSongs.create(); +begin + inherited create( false ); + self.freeonterminate := true; + + {$ifdef Delphi} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + Setlength(Song, 0); +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin + fParseSongDirectory := true; + + while not self.terminated do + begin + + if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; + +end; + +procedure TSongs.int_LoadSongList; +begin + try + fProcessing := true; + Setlength(Song, 0); + + Log.LogError('SongList', 'Searching For Songs'); + + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + if assigned( Covers ) then + Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + + finally + Log.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; +end; + +// TODO : JB - THis whole function SUX ! and needs refactoring ! :P +procedure TSongs.BrowseDir(Dir: widestring); +var + SLen: integer; + + {$ifdef Delphi} + SR: TSearchRecW; // for parsing Songs Directory + {$ENDIF} + + // eddie: can we merge that? is baseunix working on linux? oldlinux is + // not available on mac os x. + {$IFDEF LINUX} + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; + Entry : Longint; + info : oldlinux.stat; + {$ENDIF} + {$IFDEF DARWIN} + TheDir : pdir; + ADirent : pDirent; + Entry : Longint; + info : stat; + {$ENDIF} +begin + {$ifdef Delphi} + if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows + begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + BrowseDir(Dir + Sr.Name + PathDelim); + end + until FindNextw(SR) <> 0; + end; // if + FindClosew(SR); + + if FindFirstW(Dir + '*.txt', 0, SR) = 0 then + begin + repeat + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNextW(SR) <> 0; + end; // if FindFirst + FindCloseW(SR); + {$ENDIF} + + {$IFDEF LINUX} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := oldlinux.ReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( name[0] <> '.') then + BrowseDir( Dir + name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + + + + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := oldlinux.ReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.name ) > 0 ) then + begin + writeln ('***** FOUND TXT' + ADirent^.name ); + + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; + + Until ADirent=Nil; + end; // if FindFirst + {$endif} + + {$IFDEF DARWIN} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( d_name[0] <> '.') then + BrowseDir( Dir + d_name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + + + + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.d_name ) > -1 ) then + begin + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.d_name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; + + Until ADirent=Nil; + end; // if FindFirst + + {$endif} + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and + (Length(Songs.Song[S].Title)>=1) and + (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Uppercase(Songs.Song[S].Title)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := UpperCase(Songs.Song[S].Artist)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +end. diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f1f7fe47..ac3aa7d6 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1143 +1,1143 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - function LoadImage(Identifier: PChar): PSDL_Surface; - function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; - procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); - function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; - procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - - public - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) -// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) -// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) -// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - StrUtils, dialogs; - -const - fmt_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); - fmt_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); - - -Constructor TTextureUnit.Create; -begin - inherited Create; -end; - -Destructor TTextureUnit.Destroy; -begin - inherited Destroy; -end; - -function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; -end; - -// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ - 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; -// ----------------------------------------------- - -function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF WIN32} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ENDIF} - - - end; -end; - -procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_rgb; - - - if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then - begin - TempSurface:=TexSurface; - TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - Result:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); -end; - -procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - TexSurface:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - with TempSurface^.format^ do - TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); - SDL_SetAlpha(TexSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface,nil,TexSurface,nil); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - //returns hue within range [0.0-6.0) - function col2h(Color:Cardinal):double; - var - clr,hls: array[0..2] of double; - delta: double; - begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; - end; - procedure ColorizePixel(Pix: PByteArray; hue: Double); - var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; - begin - hls[0]:=hue; - - clr[0] := Pix[0]/255; - clr[1] := Pix[1]/255; - clr[2] := Pix[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) - // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - DestinationHue:=col2h(Col); - for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do - ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: Cardinal; -begin - Log.BenchmarkStart(4); - Mipmapping := true; -(* - Log.LogStatus( '', '' ); - - if Identifier = nil then - Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') - else - Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); -*) - - // load texture data into memory - {$ifdef blindydebug} - Log.LogStatus('',' ----------------------------------------------------'); - Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - - // convert pixel format as needed - {$ifdef blindydebug} - Log.LogStatus('',' AdjustPixelFormat'); - {$endif} - AdjustPixelFormat(TexSurface, Typ); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ScaleTexture'); - {$endif} - ScaleTexture(TexSurface,newWidth,newHeight); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : typ='+Typ); - {$endif} - - - - // don't actually understand, if this is needed... - // this should definately be changed... together with all this - // cover cache stuff - if (CreateCacheMipmap) and (Typ='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - if assigned(MipmapSurface) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' BlitSurface Stuff'); - {$endif} - // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end - else - begin - Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); - end; - end; - // should i create a cache texture, if Covers.W/H are larger? - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-2'); - {$endif} - - - // now we might colorize the whole thing - if Typ='Colorized' then - ColorizeTexture(TexSurface,Col); - - // save actual dimensions of our texture - oldWidth:=newWidth; - oldHeight:=newHeight; - // make texture dimensions be powers of 2 - newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); - newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitTexture(TexSurface,newWidth,newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - {$ifdef blindydebug} - Log.LogStatus('',' JB-3'); - {$endif} - - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - - // JB_linux : this is causing AV's on linux... ActText seems to be nil ! -// {$IFnDEF win32} -// if pointer(ActTex) = nil then -// exit; -// {$endif} - - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - if Typ = 'Transparent Range' then - // set alpha to 256-green-component (not sure) - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; -} -{ - if Typ = 'Font' then - // either create luminance-alpha texture - // or use transparency from differently saved file - // or do something totally different (text engine with ttf) - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then - begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - Result.Name := Identifier; - - SDL_FreeSurface(TexSurface); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-7'); - {$endif} - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - - if Name = '' then - exit; - - // find texture entry - T := FindTexture(Name); - - if T = -1 then - begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then - begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$ifdef blindydebug} - Log.LogStatus('done',' '); - {$endif} - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - end; - - if FromCache and Covers.CoverExists(Name) then - begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; +end; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF DELPHI} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ENDIF} + + + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : typ='+Typ); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} + + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 0fe5d51a..87951fed 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -1,801 +1,801 @@ -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; - Procedure Free; 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, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 - //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.')), Integer(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 -//------------- -Procedure TPluginLoader.Free; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Plugins, 0); -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)), Integer(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)), Integer(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))), Integer(PChar('TPluginLoader'))); - - //Unload Old Plugin - UnloadPlugin(Integer(nil), PluginID); - - //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)), Integer(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))), Integer(PChar('TPluginLoader'))); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); - end; - end - else - Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(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))), Integer(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))), Integer(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) | lParam (if wParam = nil) ID of the Plugin -//-------------- -Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; -var - Index: Integer; - sFile: String; -begin - Result := -1; - sFile := ''; - //lParam is ID - If (Pointer(wParam) = nil) then - begin - Index := lParam; - end - else - begin //wParam is PChar - try - sFile := String(PChar(Pointer(wParam))); - 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) | lParam (if wParam = nil) ID of the Plugin -//-------------- -Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; -var - Index: Integer; - sName: String; -begin - Result := -1; - //lParam is ID - If (Pointer(wParam) = nil) then - begin - Index := lParam; - end - else - begin //wParam is PChar - try - sName := String(PChar(Pointer(wParam))); - 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, lParam: DWord): integer; -var I: Integer; -begin - Result := 0; - If (wParam < 0) then - begin //Get Info of 1 Plugin - If (Pointer(lParam) <> nil) AND (wParam < Length(Plugins)) then - begin - Try - Result := 1; - PUS_PluginInfo(Pointer(lParam))^ := Plugins[wParam].Info; - Except - - End; - end; - end - Else If (Pointer(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(Pointer(lParam))^[I] := Plugins[I].Info; - Result := Length(Plugins); - Except - Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Pointer(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(lParam + I)^) := Plugins[I].State; - Result := Length(Plugins); - Except - Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(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 - 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 -label Continue; -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')), Integer(PChar('TtehPlugins'))); - end - else - begin - Result := True; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - I := 0; - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - Core.CurExecuted := -1 - I; - - //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))), Integer(PChar('TtehPlugins'))); - end - else - Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); - - Inc(I); - 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 + '"')), Integer(PChar('TtehPlugins'))); - - - //don't forget to increase I - Inc(I); - end; - End; - - If (I <= High(PluginLoader.Plugins)) then - Goto Continue; - - //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 -label Continue; -begin - Result := True; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - I := 0; - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - 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))), Integer(PChar('TtehPlugins'))); - end - else - Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); - - //don't forget to increase I - Inc(I); - end; - 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))), Integer(PChar('TtehPlugins'))); - - //don't forget to increase I - Inc(I); - End; - - If (I <= High(PluginLoader.Plugins)) then - GoTo Continue; - - //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 -label Continue; -begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loop - I := 0; - - Continue: - Try - While (I <= High(PluginLoader.Plugins)) do - begin - //DeInit Plugin - PluginLoader.CallDeInit(I); - - Inc(I); - end; - Except - Inc(I); - End; - - If I <= High(PluginLoader.Plugins) then - Goto Continue; - - //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; + Procedure Free; 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, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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 + //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.')), Integer(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 +//------------- +Procedure TPluginLoader.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); +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)), Integer(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)), Integer(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))), Integer(PChar('TPluginLoader'))); + + //Unload Old Plugin + UnloadPlugin(Integer(nil), PluginID); + + //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)), Integer(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))), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(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))), Integer(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))), Integer(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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + If (Pointer(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sFile := String(PChar(Pointer(wParam))); + 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) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sName: String; +begin + Result := -1; + //lParam is ID + If (Pointer(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(Pointer(wParam))); + 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, lParam: DWord): integer; +var I: Integer; +begin + Result := 0; + If (wParam < 0) then + begin //Get Info of 1 Plugin + If (Pointer(lParam) <> nil) AND (wParam < Length(Plugins)) then + begin + Try + Result := 1; + PUS_PluginInfo(Pointer(lParam))^ := Plugins[wParam].Info; + Except + + End; + end; + end + Else If (Pointer(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(Pointer(lParam))^[I] := Plugins[I].Info; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Pointer(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(lParam + I)^) := Plugins[I].State; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(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 + 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 +label Continue; +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')), Integer(PChar('TtehPlugins'))); + end + else + begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + Core.CurExecuted := -1 - I; + + //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))), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); + + Inc(I); + 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 + '"')), Integer(PChar('TtehPlugins'))); + + + //don't forget to increase I + Inc(I); + end; + End; + + If (I <= High(PluginLoader.Plugins)) then + Goto Continue; + + //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 +label Continue; +begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + 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))), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + end; + 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))), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + End; + + If (I <= High(PluginLoader.Plugins)) then + GoTo Continue; + + //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 +label Continue; +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + I := 0; + + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + //DeInit Plugin + PluginLoader.CallDeInit(I); + + Inc(I); + end; + Except + Inc(I); + End; + + If I <= High(PluginLoader.Plugins) then + Goto Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. -- cgit v1.2.3 From 84a799853df75973fe4560576d9257f20b5bef85 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sat, 3 Nov 2007 08:47:56 +0000 Subject: Changed DELPHI define to IFDEF LAZARUS ... ELSE ... ENDIF. This should work on all Platforms now (I hope). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@564 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 68 ++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 36 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index ac3aa7d6..c3ab0d41 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -277,7 +277,38 @@ begin Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); // load from resource stream - {$IFDEF DELPHI} + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} dHandle := FindResource(hInstance, Identifier, 'TEX'); if dHandle=0 then begin @@ -320,42 +351,7 @@ begin if assigned( TexStream ) then freeandnil( TexStream ); end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; {$ENDIF} - - end; end; -- cgit v1.2.3 From d29ff5bed651115af3c63b6fe4768690fb46a916 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sat, 3 Nov 2007 09:33:35 +0000 Subject: Mac OS X: Added unit cthreads. USDX now runs on OS X! But you can't do anything :-) Fonts are not working, but you can quit the program cleanly by pressing ESC and ENTER (MainLoop works). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@565 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 71 +- Game/Code/Classes/UMain.pas | 3 + Game/Code/Classes/USongs.pas | 2093 ++++++++++++++++++++-------------------- 3 files changed, 1089 insertions(+), 1078 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index e13fdf43..02c06002 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -566,6 +566,11 @@ begin W := 800; H := 600; {$endif} + + {$IFDEF DARWIN} + // Todo : eddie: remove before realease + Ini.FullScreen := 0; + {$ENDIF} if (Ini.FullScreen = 0) and (Not Params.FullScreen) then begin @@ -702,39 +707,39 @@ begin end; procedure UnLoadScreens; -begin - freeandnil( ScreenMain ); - freeandnil( ScreenName ); - freeandnil( ScreenLevel); - freeandnil( ScreenSong ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSing ); - freeandnil( ScreenScore); - freeandnil( ScreenTop5 ); - freeandnil( ScreenOptions ); - freeandnil( ScreenOptionsGame ); - freeandnil( ScreenOptionsGraphics ); - freeandnil( ScreenOptionsSound ); - freeandnil( ScreenOptionsLyrics ); -// freeandnil( ScreenOptionsThemes ); - freeandnil( ScreenOptionsRecord ); - freeandnil( ScreenOptionsAdvanced ); - freeandnil( ScreenEditSub ); - freeandnil( ScreenEdit ); - freeandnil( ScreenEditConvert ); - freeandnil( ScreenOpen ); - freeandnil( ScreenSingModi ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSongJumpto); - freeandnil( ScreenPopupCheck ); - freeandnil( ScreenPopupError ); - freeandnil( ScreenPartyNewRound ); - freeandnil( ScreenPartyScore ); - freeandnil( ScreenPartyWin ); - freeandnil( ScreenPartyOptions ); - freeandnil( ScreenPartyPlayer ); - freeandnil( ScreenStatMain ); - freeandnil( ScreenStatDetail ); +begin + freeandnil( ScreenMain ); + freeandnil( ScreenName ); + freeandnil( ScreenLevel); + freeandnil( ScreenSong ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSing ); + freeandnil( ScreenScore); + freeandnil( ScreenTop5 ); + freeandnil( ScreenOptions ); + freeandnil( ScreenOptionsGame ); + freeandnil( ScreenOptionsGraphics ); + freeandnil( ScreenOptionsSound ); + freeandnil( ScreenOptionsLyrics ); +// freeandnil( ScreenOptionsThemes ); + freeandnil( ScreenOptionsRecord ); + freeandnil( ScreenOptionsAdvanced ); + freeandnil( ScreenEditSub ); + freeandnil( ScreenEdit ); + freeandnil( ScreenEditConvert ); + freeandnil( ScreenOpen ); + freeandnil( ScreenSingModi ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSongJumpto); + freeandnil( ScreenPopupCheck ); + freeandnil( ScreenPopupError ); + freeandnil( ScreenPartyNewRound ); + freeandnil( ScreenPartyScore ); + freeandnil( ScreenPartyWin ); + freeandnil( ScreenPartyOptions ); + freeandnil( ScreenPartyPlayer ); + freeandnil( ScreenStatMain ); + freeandnil( ScreenStatDetail ); end; end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 1be4b463..48928cbd 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -12,6 +12,9 @@ uses {$IFDEF MSWINDOWS} Windows, {$ENDIF} + {$IFDEF DARWIN} // needed for initialization of cthreads + cthreads, + {$ENDIF} SDL, UGraphic, UMusic, diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 2fa3ea4a..96d9ad2e 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,1045 +1,1048 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ifdef Delphi} - DirWatch, - {$endif} - {$ELSE} - {$IFNDEF DARWIN} - oldlinux, - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - ULog, - UTexture, - UCommon, - UCatCovers; - -type - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - TSong = record - Path: widestring; - Folder: widestring; // for sorting by folder - FileName: widestring; - - // sorting methods - Category: array of widestring; // I think I won't need this - Genre: widestring; - Edition: widestring; - Language: widestring; // 0.5.0: new - - Title: widestring; - Artist: widestring; - - Text: widestring; - Creator: widestring; - - Cover: widestring; - CoverTex: TTexture; - Mp3: widestring; - Background: widestring; - Video: widestring; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - - TSongs = class( TThread ) - private - BrowsePos : Cardinal; //Actual Pos in Song Array - fNotify , - fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; - {$ifdef Delphi} - fDirWatch : TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public - Song : array of TSong; // array of songs - Selected : integer; // selected song index - constructor create(); - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; - end; - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; - -{$IFDEF DARWIN} -function AnsiContainsText(const AText, ASubText: string): Boolean; -begin - Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; -end; -{$ENDIF} - -constructor TSongs.create(); -begin - inherited create( false ); - self.freeonterminate := true; - - {$ifdef Delphi} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - {$IFDEF linux} - (* - Thankyou to : http://www.linuxjournal.com/article/8478 - http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch - *) -(* - fNotify := -1; - fWatch := -1; - - writeln( 'Calling inotify_init' ); - fNotify := Do_SysCall( syscall_nr_inotify_init ); - if ( fNotify < 0 ) then - writeln( 'Filesystem change notification - disabled' ); - writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); - - writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); - fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); - - if (fWatch < 0) then - writeln ('inotify_add_watch'); - writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); -*) - {$endif} - - Setlength(Song, 0); -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify : THandle; -begin - fParseSongDirectory := true; - - while not self.terminated do - begin - - if fParseSongDirectory then - begin - writeln( 'int_LoadSongList' ); - int_LoadSongList(); - end; - - self.suspend; - end; - -end; - -procedure TSongs.int_LoadSongList; -begin - try - fProcessing := true; - Setlength(Song, 0); - - Log.LogError('SongList', 'Searching For Songs'); - - Setlength(Song, 50); - - BrowsePos := 0; - // browse directories - BrowseDir(SongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); - - if assigned( CatSongs ) then - CatSongs.Refresh; - - if assigned( CatCovers ) then - CatCovers.Load; - - if assigned( Covers ) then - Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - - finally - Log.LogError('SongList', 'Search Complete'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - self.resume; -end; - -// TODO : JB - THis whole function SUX ! and needs refactoring ! :P -procedure TSongs.BrowseDir(Dir: widestring); -var - SLen: integer; - - {$ifdef Delphi} - SR: TSearchRecW; // for parsing Songs Directory - {$ENDIF} - - // eddie: can we merge that? is baseunix working on linux? oldlinux is - // not available on mac os x. - {$IFDEF LINUX} - TheDir : oldlinux.pdir; - ADirent : oldlinux.pDirent; - Entry : Longint; - info : oldlinux.stat; - {$ENDIF} - {$IFDEF DARWIN} - TheDir : pdir; - ADirent : pDirent; - Entry : Longint; - info : stat; - {$ENDIF} -begin - {$ifdef Delphi} - if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows - begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - begin - BrowseDir(Dir + Sr.Name + PathDelim); - end - until FindNextw(SR) <> 0; - end; // if - FindClosew(SR); - - if FindFirstW(Dir + '*.txt', 0, SR) = 0 then - begin - repeat - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNextW(SR) <> 0; - end; // if FindFirst - FindCloseW(SR); - {$ENDIF} - - {$IFDEF LINUX} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - If ADirent<>Nil then - begin - With ADirent^ do - begin - - if ( name[0] <> '.') then - BrowseDir( Dir + name + pathdelim ); - - end; - end; - Until ADirent=Nil; - end; - - - - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.name ) > 0 ) then - begin - writeln ('***** FOUND TXT' + ADirent^.name ); - - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst - {$endif} - - {$IFDEF DARWIN} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - If ADirent<>Nil then - begin - With ADirent^ do - begin - - if ( d_name[0] <> '.') then - BrowseDir( Dir + d_name + pathdelim ); - - end; - end; - Until ADirent=Nil; - end; - - - - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.d_name ) > -1 ) then - begin - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.d_name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst - - {$endif} - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin - // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := Low(Songs.Song) to High(Songs.Song) do begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := Songs.Song[S].Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := Songs.Song[S].Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := Songs.Song[S].Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and - (Length(Songs.Song[S].Title)>=1) and - (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := Uppercase(Songs.Song[S].Title)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := UpperCase(Songs.Song[S].Artist)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := Songs.Song[S].Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := Songs.Song[S]; - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ifdef Delphi} + DirWatch, + {$endif} + {$ELSE} + {$IFNDEF DARWIN} + oldlinux, + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + TSong = record + Path: widestring; + Folder: widestring; // for sorting by folder + FileName: widestring; + + // sorting methods + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new + + Title: widestring; + Artist: widestring; + + Text: widestring; + Creator: widestring; + + Cover: widestring; + CoverTex: TTexture; + Mp3: widestring; + Background: widestring; + Video: widestring; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + end; + + TSongs = class( TThread ) + private + BrowsePos : Cardinal; //Actual Pos in Song Array + fNotify , + fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef Delphi} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public + Song : array of TSong; // array of songs + Selected : integer; // selected song index + constructor create(); + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + AktSong: TSong; // one song *unknown use) + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} + +constructor TSongs.create(); +begin + inherited create( false ); + self.freeonterminate := true; + + {$ifdef Delphi} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + Setlength(Song, 0); +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin + fParseSongDirectory := true; + + while not self.terminated do + begin + + if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; + +end; + +procedure TSongs.int_LoadSongList; +begin + try + fProcessing := true; + Setlength(Song, 0); + + Log.LogError('SongList', 'Searching For Songs'); + + Setlength(Song, 50); + + BrowsePos := 0; + // browse directories + BrowseDir(SongPath); + + //Set Correct SongArray Length + SetLength(Song, BrowsePos); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + if assigned( Covers ) then + Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + + finally + Log.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; +end; + +// TODO : JB - THis whole function SUX ! and needs refactoring ! :P +procedure TSongs.BrowseDir(Dir: widestring); +var + SLen: integer; + + {$ifdef Delphi} + SR: TSearchRecW; // for parsing Songs Directory + {$ENDIF} + + // eddie: can we merge that? is baseunix working on linux? oldlinux is + // not available on mac os x. + {$IFDEF LINUX} + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; + Entry : Longint; + info : oldlinux.stat; + {$ENDIF} + {$IFDEF DARWIN} + TheDir : pdir; + ADirent : pDirent; + Entry : Longint; + info : stat; + {$ENDIF} +begin + {$ifdef Delphi} + if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows + begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + BrowseDir(Dir + Sr.Name + PathDelim); + end + until FindNextw(SR) <> 0; + end; // if + FindClosew(SR); + + if FindFirstW(Dir + '*.txt', 0, SR) = 0 then + begin + repeat + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := SR.Name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + + until FindNextW(SR) <> 0; + end; // if FindFirst + FindCloseW(SR); + {$ENDIF} + + {$IFDEF LINUX} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := oldlinux.ReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( name[0] <> '.') then + BrowseDir( Dir + name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + + + + TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := oldlinux.ReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.name ) > 0 ) then + begin + writeln ('***** FOUND TXT' + ADirent^.name ); + + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; + + Until ADirent=Nil; + end; // if FindFirst + {$endif} + + {$IFDEF DARWIN} + // Itterate the Songs Directory... ( With unicode capable functions for linux ) + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + If ADirent<>Nil then + begin + With ADirent^ do + begin + + if ( d_name[0] <> '.') then + BrowseDir( Dir + d_name + pathdelim ); + + end; + end; + Until ADirent=Nil; + end; + + + + TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + if TheDir <> nil then + begin + repeat + ADirent := FPReadDir(TheDir); + + if ( ADirent <> Nil ) AND + ( pos( '.txt', ADirent^.d_name ) > -1 ) then + begin + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.d_name; + + if (AnalyseFile(Song[SLen]) = false) then + Dec(BrowsePos) + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; + + Until ADirent=Nil; + end; // if FindFirst + + {$endif} + +// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); + + +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + // zamiana miejscami + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to Length(Song)-1 do + for S := 1 to Length(Song)-1 do + if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin + TempSong := Song[S-1]; + Song[S-1] := Song[S]; + Song[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := Low(Songs.Song) to High(Songs.Song) do begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := Songs.Song[S].Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := Songs.Song[S].Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := Songs.Song[S].Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and + (Length(Songs.Song[S].Title)>=1) and + (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Uppercase(Songs.Song[S].Title)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := UpperCase(Songs.Song[S].Artist)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := Songs.Song[S].Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin + if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin + if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +end. -- cgit v1.2.3 From 9edc9535e5570807990e39703dca7c05e6758256 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sun, 4 Nov 2007 15:23:42 +0000 Subject: Added MacResources.pas. Fixed some resource loading issues on OS X. The main screen is still not loading. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@581 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2281 ++++++++++++++++++++-------------------- 1 file changed, 1142 insertions(+), 1139 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index c3ab0d41..7b537840 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1139 +1,1142 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - function LoadImage(Identifier: PChar): PSDL_Surface; - function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; - procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); - function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; - procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - - public - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) -// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) -// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) -// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - StrUtils, dialogs; - -const - fmt_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); - fmt_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); - - -Constructor TTextureUnit.Create; -begin - inherited Create; -end; - -Destructor TTextureUnit.Destroy; -begin - inherited Destroy; -end; - -function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; -end; - -// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ - 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; -// ----------------------------------------------- - -function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_rgb; - - - if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then - begin - TempSurface:=TexSurface; - TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - Result:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); -end; - -procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - TexSurface:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - with TempSurface^.format^ do - TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); - SDL_SetAlpha(TexSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface,nil,TexSurface,nil); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - //returns hue within range [0.0-6.0) - function col2h(Color:Cardinal):double; - var - clr,hls: array[0..2] of double; - delta: double; - begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; - end; - procedure ColorizePixel(Pix: PByteArray; hue: Double); - var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; - begin - hls[0]:=hue; - - clr[0] := Pix[0]/255; - clr[1] := Pix[1]/255; - clr[2] := Pix[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) - // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - DestinationHue:=col2h(Col); - for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do - ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: Cardinal; -begin - Log.BenchmarkStart(4); - Mipmapping := true; -(* - Log.LogStatus( '', '' ); - - if Identifier = nil then - Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') - else - Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); -*) - - // load texture data into memory - {$ifdef blindydebug} - Log.LogStatus('',' ----------------------------------------------------'); - Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - - // convert pixel format as needed - {$ifdef blindydebug} - Log.LogStatus('',' AdjustPixelFormat'); - {$endif} - AdjustPixelFormat(TexSurface, Typ); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ScaleTexture'); - {$endif} - ScaleTexture(TexSurface,newWidth,newHeight); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : typ='+Typ); - {$endif} - - - - // don't actually understand, if this is needed... - // this should definately be changed... together with all this - // cover cache stuff - if (CreateCacheMipmap) and (Typ='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - if assigned(MipmapSurface) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' BlitSurface Stuff'); - {$endif} - // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end - else - begin - Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); - end; - end; - // should i create a cache texture, if Covers.W/H are larger? - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-2'); - {$endif} - - - // now we might colorize the whole thing - if Typ='Colorized' then - ColorizeTexture(TexSurface,Col); - - // save actual dimensions of our texture - oldWidth:=newWidth; - oldHeight:=newHeight; - // make texture dimensions be powers of 2 - newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); - newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitTexture(TexSurface,newWidth,newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - {$ifdef blindydebug} - Log.LogStatus('',' JB-3'); - {$endif} - - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - - // JB_linux : this is causing AV's on linux... ActText seems to be nil ! -// {$IFnDEF win32} -// if pointer(ActTex) = nil then -// exit; -// {$endif} - - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - if Typ = 'Transparent Range' then - // set alpha to 256-green-component (not sure) - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; -} -{ - if Typ = 'Font' then - // either create luminance-alpha texture - // or use transparency from differently saved file - // or do something totally different (text engine with ttf) - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then - begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - Result.Name := Identifier; - - SDL_FreeSurface(TexSurface); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-7'); - {$endif} - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - - if Name = '' then - exit; - - // find texture entry - T := FindTexture(Name); - - if T = -1 then - begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then - begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$ifdef blindydebug} - Log.LogStatus('done',' '); - {$endif} - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - end; - - if FromCache and Covers.CoverExists(Name) then - begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; +end; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : typ='+Typ); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} + + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From 5e733f7e9cb2118651df90171db1892c9155e089 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 4 Nov 2007 21:00:20 +0000 Subject: Partymodule finished. All PartyScreens and SingScreen needs some adapting. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@583 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 25 +- Game/Code/Classes/UMain.pas | 31 +- Game/Code/Classes/UParty.pas | 994 +++++++++++++++++++++++++--------------- Game/Code/Classes/UServices.pas | 2 +- 4 files changed, 644 insertions(+), 408 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index e0f9fec2..5b144b45 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -47,6 +47,12 @@ type 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; @@ -75,14 +81,14 @@ type Hooks: THookManager; //Teh Hook Manager ;) Services: TServiceManager;//The Service Manager - CurExecuted: Integer; //ID of Plugin or Module curently Executed - 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: @@ -124,7 +130,8 @@ Constructor TCore.Create(const cName: String; const cVersion: LongWord); begin Name := cName; Version := cVersion; - CurExecuted := 0; + iLastExecuted := 0; + iCurExecuted := 0; LastErrorReporter := ''; LastErrorString := ''; @@ -498,4 +505,16 @@ 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/UMain.pas b/Game/Code/Classes/UMain.pas index 48928cbd..b1469f00 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -38,6 +38,11 @@ type TPlayer = record Name: string; + //Index in Teaminfo record + TeamID: Byte; + PlayerID: Byte; + + //Scores Score: real; ScoreLine: real; ScoreGolden: real; @@ -51,26 +56,6 @@ type //LineBonus Mod ScoreLast: Real;//Last Line Score - {ScorePercent: integer;//Aktual Fillstate of the SingBar - ScorePercentTarget: integer;//Target Fillstate of the SingBar - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - LineBonus_PosX: Single; - LineBonus_PosY: Single; - LineBonus_Alpha: Single; - LineBonus_Visible: boolean; - LineBonus_Text: string; - LineBonus_Color: TRGB; - LineBonus_Age: Integer; - LineBonus_Rating: Integer; - //Variable vor Positioning -> Set on ScreenShow, different when Playercount Changes - LineBonus_TargetX: integer; - LineBonus_TargetY: integer; - LineBonus_StartX: integer; - LineBonus_StartY: integer; - //PhrasenBonus - Line Bonus Mod End } - //PerfectLineTwinkle Mod (effect) LastSentencePerfect: Boolean; @@ -316,13 +301,13 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); - // Party Mode Manager + {// Party Mode Manager Log.BenchmarkStart(1); Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TParty_Session.Create; //Load PartySession + PartySession := TPartySession.Create; //Load PartySession Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); + Log.LogBenchmark('Loading PartySession Manager', 1); } // Sound Log.BenchmarkStart(1); diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 36a40858..1db8f3e1 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,381 +1,613 @@ -unit UParty; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - - -{$I switches.inc} - -uses ModiSDK; - -type - TRoundInfo = record - Plugin: Word; - Winner: Byte; - end; - - TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; - end; - - TeamOrderArray = Array[0..5] of Byte; - - TParty_Session = class - private - function GetRandomPlayer(Team: Byte): Byte; - function IsWinner(Player, Winner: Byte): boolean; - procedure GenScores; - public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: Byte; - - constructor Create; - - procedure StartNewParty(NumRounds: Byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: Byte): String; - end; - -var - PartySession: TParty_Session; - -implementation - -uses UDLLManager, UGraphic, UMain, ULanguage, ULog; - -//---------- -//Constructor - Prepares the Class -//---------- -constructor TParty_Session.Create; -begin -// - Nothing in here atm -end; - -//---------- -//StartNewParty - Clears the Class and Prepares for new Party -//---------- -procedure TParty_Session.StartNewParty(NumRounds: Byte); -var - Plugins: Array of record - ID: Byte; - TimesPlayed: Byte; - end; - TeamMode: Boolean; - Len: Integer; - I, J: Integer; - - function GetRandomPlugin: Byte; - var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; - begin - LowestTP := high(Byte); - NumPwithLTP := 0; - - //Search for Plugins not often played yet - For I := 0 to high(Plugins) do - begin - if (Plugins[I].TimesPlayed < lowestTP) then - begin - lowestTP := Plugins[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Plugins[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Plugin - For I := 0 to high(Plugins) do - begin - if Plugins[I].TimesPlayed = lowestTP then - begin - //Plugin Found - if (R = 0) then - begin - Result := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); - Break; - end; - - Dec(R); - end; - end; - end; -begin - //Set cur Round to Round 1 - CurRound := 255; - - PlayersPlay := Teams.NumTeams; - - //Get Teammode and Set Joker, also set TimesPlayed - TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - begin - if Teams.Teaminfo[I].NumPlayers < 2 then - begin - TeamMode := False; - end; - //Set Player Attributes - For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do - begin - Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; - end; - Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); - Teams.Teaminfo[I].Score := 0; - end; - - //Fill Plugin Array - SetLength(Plugins, 0); - For I := 0 to high(DLLMan.Plugins) do - begin - if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then - begin //Add only Plugins Playable with cur. PlayerConfiguration - Len := Length(Plugins); - SetLength(Plugins, Len + 1); - Plugins[Len].ID := I; - Plugins[Len].TimesPlayed := 0; - end; - end; - - //Set Rounds - If (Length(Plugins) >= 1) then - begin - SetLength (Rounds, NumRounds); - For I := 0 to NumRounds-1 do - begin - PartySession.Rounds[I].Plugin := GetRandomPlugin; - PartySession.Rounds[I].Winner := 255; - end; - end - else SetLength (Rounds, 0); -end; - -//---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round -//---------- -function TParty_Session.GetRandomPlayer(Team: Byte): Byte; -var - I, R: Integer; - lowestTP: Byte; - NumPwithLTP: Byte; -begin - LowestTP := high(Byte); - NumPwithLTP := 0; - Result := 0; - - //Search for Players that have not often played yet - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Player - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then - begin - //Player Found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); - end; - end; - {//Get lowest TimesPlayed - lowestTP := high(Byte); - J := -1; - for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - J := I; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - J := -1; - end; - end; - - //If more than one Person has lowestTP then Select Random Player - if (J < 0) then - repeat - Result := Random(Teams.Teaminfo[Team].NumPlayers); - until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) - else //Else Select the one with lowest TP - Result:= J;} -end; - -//---------- -//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin -//---------- -procedure TParty_Session.StartRound; -var - I: Integer; -begin - if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then - begin - //Increase Current Round - Inc (CurRound); - - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); - - //Select Players - for I := 0 to Teams.NumTeams-1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; - - //Set - end; -end; - -//---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte -//---------- -function TParty_Session.IsWinner(Player, Winner: Byte): boolean; -var - Bit: Byte; -begin - Case Player of - 0: Bit := 1; - 1: Bit := 2; - 2: Bit := 4; - 3: Bit := 8; - 4: Bit := 16; - 5: Bit := 32; - end; - - Result := ((Winner AND Bit) = Bit); -end; - -//---------- -//GenScores - Inc Scores for Cur. Round -//---------- -procedure TParty_Session.GenScores; -var - I: Byte; -begin - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); - end; -end; - -//---------- -//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , -//---------- -function TParty_Session.GetWinnerString(Round: Byte): String; -var - Winners: Array of String; - I: Integer; -begin - Result := Language.Translate('PARTY_NOBODY'); - - if (Round > High(Rounds)) then - exit; - - if (Rounds[Round].Winner = 0) then - begin - exit; - end; - - if (Rounds[Round].Winner = 255) then - begin - Result := Language.Translate('PARTY_NOTPLAYEDYET'); - exit; - end; - - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[Round].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - Result := Language.Implode(Winners); -end; - -//---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray -//---------- -procedure TParty_Session.EndRound; -var - I: Integer; -begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; - - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); - -end; - -//---------- -//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] -//---------- -function TParty_Session.GetTeamOrder: TeamOrderArray; -var - I, J: Integer; - ATeams: array [0..5] of TeamOrderEntry; - TempTeam: TeamOrderEntry; -begin - //Fill Team Array - For I := 0 to Teams.NumTeams-1 do - begin - ATeams[I].Teamnum := I; - ATeams[I].Score := Teams.Teaminfo[I].Score; - end; - - //Sort Teams - for J := 0 to Teams.NumTeams-1 do - for I := 1 to Teams.NumTeams-1 do - if ATeams[I].Score > ATeams[I-1].Score then - begin - TempTeam := ATeams[I-1]; - ATeams[I-1] := ATeams[I]; - ATeams[I] := TempTeam; - end; - - //Copy to Result - For I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; -end; - -end. +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; + Procedure Free; override; + + //Register Modi Service + Function RegisterModi(pModiInfo, nothin: DWord): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + + //Start new Party + Function StartParty(NumRounds, PAofIRounds: DWord): integer; //Starts new Party Mode. Returns Non Zero on Success + Function GetCurModi(wParam, lParam: DWord): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) + Function StopParty(wParam, lParam: DWord): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. + Function NextRound(wParam, lParam: DWord): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + + Function CallModiInit(wParam, lParam: DWord): 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, lParam: DWord): integer; //Calls DeInitProc and does the RoundEnding + + Function GetTeamInfo(wParam, pTeamInfo: DWord): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success + Function SetTeamInfo(wParam, pTeamInfo: DWord): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + + Function GetTeamOrder(wParam, lParam: DWord): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... + Function GetWinnerString(wParam, lParam: DWord): 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 + //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 +//------------- +Procedure TPartySession.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Modis, 0); +end; + +//------------- +// Registers a new Modi. wParam: Pointer to TUS_ModiInfo +// Service for Plugins +//------------- +Function TPartySession.RegisterModi(pModiInfo, nothin: DWord): integer; +var + Len: Integer; + Info: PUS_ModiInfo; +begin + Info := ptr(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.')), Integer(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, PAofIRounds: DWord): 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 := Ptr(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); + + For I := 0 to High(NumRounds) 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.')), Integer(PChar('TPartySession'))); + end; + end; +end; + +//---------- +// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +//---------- +Function TPartySession.GetCurModi(wParam, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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)), Integer(PChar('TPartySession'))); + If (Rounds[CurRound].Modi = StandardModi) then + begin + Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), Integer(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, lParam: DWord): 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].ScoreTotalI > MaxScore) then + begin + MaxScore := Player[I].ScoreTotalI; + Rounds[CurRound].Winner := 1 shl I; + end + else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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, pTeamInfo: DWord): integer; +var Info: ^TTeamInfo; +begin + Result := -1; + Info := ptr(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, pTeamInfo: DWord): integer; +var + TeamInfobackup: TTeamInfo; + Info: ^TTeamInfo; +begin + Result := -1; + Info := ptr(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, lParam: DWord): 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, lParam: DWord): 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 (ptr(lParam) = nil) then + begin //ReturnString Length + Result := Length(ResultStr); + end + Else + begin //Return String + Try + S := Ptr(lParam); + S^ := ResultStr; + Result := 0; + Except + Result := -1; + + End; + end; +end; + +end. diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index c8761df0..094c3fed 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -247,7 +247,7 @@ end; Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; asm { CL: Counter; EAX: Result; EDX: Current Memory Address } - Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} + Mov 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"} -- cgit v1.2.3 From 47da0a4d8f298bc3bc32e19242aa2d714e2c5ebc Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Mon, 5 Nov 2007 19:49:10 +0000 Subject: Fixed compilation on the mac: Function Ptr() does not exist. Please use the Pointer() cast. Changed function StartParty. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@588 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UParty.pas | 1227 +++++++++++++++++++++--------------------- 1 file changed, 614 insertions(+), 613 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 1db8f3e1..3fc52b8e 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,613 +1,614 @@ -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; - Procedure Free; override; - - //Register Modi Service - Function RegisterModi(pModiInfo, nothin: DWord): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo - - //Start new Party - Function StartParty(NumRounds, PAofIRounds: DWord): integer; //Starts new Party Mode. Returns Non Zero on Success - Function GetCurModi(wParam, lParam: DWord): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) - Function StopParty(wParam, lParam: DWord): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. - Function NextRound(wParam, lParam: DWord): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played - - Function CallModiInit(wParam, lParam: DWord): 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, lParam: DWord): integer; //Calls DeInitProc and does the RoundEnding - - Function GetTeamInfo(wParam, pTeamInfo: DWord): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success - Function SetTeamInfo(wParam, pTeamInfo: DWord): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success - - Function GetTeamOrder(wParam, lParam: DWord): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... - Function GetWinnerString(wParam, lParam: DWord): 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 - //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 -//------------- -Procedure TPartySession.Free; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Modis, 0); -end; - -//------------- -// Registers a new Modi. wParam: Pointer to TUS_ModiInfo -// Service for Plugins -//------------- -Function TPartySession.RegisterModi(pModiInfo, nothin: DWord): integer; -var - Len: Integer; - Info: PUS_ModiInfo; -begin - Info := ptr(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.')), Integer(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, PAofIRounds: DWord): 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 := Ptr(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); - - For I := 0 to High(NumRounds) 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.')), Integer(PChar('TPartySession'))); - end; - end; -end; - -//---------- -// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) -//---------- -Function TPartySession.GetCurModi(wParam, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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)), Integer(PChar('TPartySession'))); - If (Rounds[CurRound].Modi = StandardModi) then - begin - Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), Integer(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, lParam: DWord): 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].ScoreTotalI > MaxScore) then - begin - MaxScore := Player[I].ScoreTotalI; - Rounds[CurRound].Winner := 1 shl I; - end - else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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, pTeamInfo: DWord): integer; -var Info: ^TTeamInfo; -begin - Result := -1; - Info := ptr(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, pTeamInfo: DWord): integer; -var - TeamInfobackup: TTeamInfo; - Info: ^TTeamInfo; -begin - Result := -1; - Info := ptr(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, lParam: DWord): 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, lParam: DWord): 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 (ptr(lParam) = nil) then - begin //ReturnString Length - Result := Length(ResultStr); - end - Else - begin //Return String - Try - S := Ptr(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; + Procedure Free; override; + + //Register Modi Service + Function RegisterModi(pModiInfo, nothin: DWord): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + + //Start new Party + Function StartParty(NumRounds, PAofIRounds: DWord): integer; //Starts new Party Mode. Returns Non Zero on Success + Function GetCurModi(wParam, lParam: DWord): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) + Function StopParty(wParam, lParam: DWord): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. + Function NextRound(wParam, lParam: DWord): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + + Function CallModiInit(wParam, lParam: DWord): 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, lParam: DWord): integer; //Calls DeInitProc and does the RoundEnding + + Function GetTeamInfo(wParam, pTeamInfo: DWord): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success + Function SetTeamInfo(wParam, pTeamInfo: DWord): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + + Function GetTeamOrder(wParam, lParam: DWord): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... + Function GetWinnerString(wParam, lParam: DWord): 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 + //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 +//------------- +Procedure TPartySession.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Modis, 0); +end; + +//------------- +// Registers a new Modi. wParam: Pointer to TUS_ModiInfo +// Service for Plugins +//------------- +Function TPartySession.RegisterModi(pModiInfo, nothin: DWord): integer; +var + Len: Integer; + Info: PUS_ModiInfo; +begin + Info := Pointer(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.')), Integer(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, PAofIRounds: DWord): 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 := Pointer(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); + + // For I := 0 to High(NumRounds) do // eddie: changed NumRounds to Rounds - is this correct ??? I get compile errors on the mac otherwise... + 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.')), Integer(PChar('TPartySession'))); + end; + end; +end; + +//---------- +// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +//---------- +Function TPartySession.GetCurModi(wParam, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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)), Integer(PChar('TPartySession'))); + If (Rounds[CurRound].Modi = StandardModi) then + begin + Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), Integer(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, lParam: DWord): 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].ScoreTotalI > MaxScore) then + begin + MaxScore := Player[I].ScoreTotalI; + Rounds[CurRound].Winner := 1 shl I; + end + else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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, pTeamInfo: DWord): integer; +var Info: ^TTeamInfo; +begin + Result := -1; + Info := Pointer(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, pTeamInfo: DWord): integer; +var + TeamInfobackup: TTeamInfo; + Info: ^TTeamInfo; +begin + Result := -1; + Info := Pointer(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, lParam: DWord): 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, lParam: DWord): 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 (Pointer(lParam) = nil) then + begin //ReturnString Length + Result := Length(ResultStr); + end + Else + begin //Return String + Try + S := Pointer(lParam); + S^ := ResultStr; + Result := 0; + Except + Result := -1; + + End; + end; +end; + +end. -- cgit v1.2.3 From eee3f173ec616e89dea23d4aa192e68587eea148 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Mon, 5 Nov 2007 23:38:15 +0000 Subject: Mac OS X: We're getting closer! Songs get loaded. Sound is playing on the SingScreen. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@591 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 3 ++ Game/Code/Classes/UMain.pas | 2 +- Game/Code/Classes/USongs.pas | 94 ++++++++++++++++++++++---------------------- 3 files changed, 51 insertions(+), 48 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index aaee50a0..7475da7a 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -85,6 +85,9 @@ uses UMain, {$IFDEF LAZARUS} LResources, {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} UGraphic; procedure BuildFont; // Build Our Bitmap Font diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index b1469f00..f25eaa87 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1051,7 +1051,7 @@ procedure InitializePaths; If DirectoryExists(aPathVar) then begin - lAttrib := fileGetAttr('C:Temp'); + lAttrib := fileGetAttr(aPathVar); lWriteable := ( lAttrib and faDirectory <> 0 ) AND NOT ( lAttrib and faReadOnly <> 0 ) diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 96d9ad2e..a04c1032 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -302,6 +302,7 @@ var ADirent : pDirent; Entry : Longint; info : stat; + lAttrib : integer; {$ENDIF} begin {$ifdef Delphi} @@ -410,62 +411,61 @@ begin {$IFDEF DARWIN} // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux + TheDir := FPOpenDir(Dir); // JB_Unicode - linux if TheDir <> nil then begin repeat ADirent := FPReadDir(TheDir); - If ADirent<>Nil then + If assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then begin - With ADirent^ do - begin - - if ( d_name[0] <> '.') then - BrowseDir( Dir + d_name + pathdelim ); - - end; + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if (lAttrib and faDirectory) <> 0 then + begin + //Log.LogError('Entering dir "' + Dir + ADirent^.d_name + PathDelim + '" now.'); + BrowseDir(Dir + ADirent^.d_name + PathDelim); + end + else if Pos( '.txt', LowerCase(ADirent^.d_name)) > 0 then + begin + SLen := BrowsePos; + + try + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(String(Dir), Length(String(SongPath))+1, 10000); + Song[SLen].Folder := Copy(String(Song[SLen].Folder), 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := ADirent^.d_name; + //Log.LogError( 'Song: ' + ADirent^.d_name + ', Length(Song) = ' + inttostr(Length(Song)) + ', BrowsePos = ' + IntToStr(BrowsePos) + ', Dir = "' + Dir + '"'); + + if (AnalyseFile(Song[SLen]) = false) then + begin + Log.LogError('AnalyseFile failed for "' + ADirent^.d_name + '".'); + Dec(BrowsePos); + end + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + except + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; + end; end; + Until ADirent=Nil; + + if (FPCloseDir(TheDir) <> 0) then + begin + Log.LogError('TSongs.BrowseDir: Exception: Error closing dir: "' + Dir + '".') + end; end; - - - - TheDir := FPOpenDir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.d_name ) > -1 ) then - begin - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.d_name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst {$endif} -- cgit v1.2.3 From a1a9c43dcd6f61610eb3afea542aec5de5dabf30 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 6 Nov 2007 19:40:06 +0000 Subject: Some changes to PluginInterface to fit with 64 Bit Systems. lParam is maily for use as Pointer, therefore standardtype: Pointer. wParam should mainly be used for ordinals. (Integer or Int64 on 64Bit Systems). Don't return addresses. Result is not assured to be Int64 on 64 Bit Systems. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@592 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 68 +- Game/Code/Classes/UHooks.pas | 10 +- Game/Code/Classes/UParty.pas | 1230 ++++++++++++++++---------------- Game/Code/Classes/UPluginInterface.pas | 8 +- Game/Code/Classes/UServices.pas | 4 +- Game/Code/Classes/uPluginLoader.pas | 92 +-- 6 files changed, 707 insertions(+), 705 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 5b144b45..c150ff34 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -104,13 +104,13 @@ type //-------------- // Hook and Service Procs: //-------------- - Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook - Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook - Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle + 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 @@ -196,50 +196,50 @@ begin else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error calling LoadingFinished Hook: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error calling LoadingFinished Hook')); end; end else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading textures: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading textures')); end; end else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error translating: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error translating')); end; end else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error initing Modules: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error initing Modules')); end; end else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading Modules: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading Modules')); end; end else begin If (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString))) + Self.ShowMessage(CORE_SM_ERROR, PChar('Error Getting Modules: ' + LastErrorString)) else - Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules'))); + Self.ShowMessage(CORE_SM_ERROR, PChar('Error Getting Modules')); end; //DeInit @@ -272,7 +272,7 @@ begin end; Result := True; except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core')); end; end; @@ -292,7 +292,7 @@ begin Result := Modules[I].Module.Load; except Result := False; - ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core')); end; Inc(I); @@ -315,7 +315,7 @@ begin Result := Modules[I].Module.Init; except Result := False; - ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core'))); + ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core')); end; Modules[I].NeedsDeInit := Result; @@ -414,13 +414,13 @@ end; //------------- // Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) //------------- -Function TCore.ShowMessage(wParam, lParam: DWord): integer; +Function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; var Params: Cardinal; begin Result := -1; {$IFDEF Delphi} - If (ptr(lParam)<>nil) then + If (lParam<>nil) then begin Params := MB_OK; Case wParam of @@ -430,7 +430,7 @@ begin end; //Anzeigen: - Result := Messagebox(0, ptr(lParam), PChar(Name), Params); + Result := Messagebox(0, lParam, PChar(Name), Params); end; {$ENDIF} @@ -440,10 +440,10 @@ end; //------------- // Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) //------------- -Function TCore.ReportError(wParam, lParam: DWord): integer; +Function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; begin //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(Pointer(lParam))); + LastErrorReporter := String(PChar(lParam)); LastErrorString := String(PChar(Pointer(wParam))); Hooks.CallEventChain(hError, wParam, lParam); @@ -452,7 +452,7 @@ end; //------------- // Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) //------------- -Function TCore.ReportDebug(wParam, lParam: DWord): integer; +Function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; begin Hooks.CallEventChain(hDebug, wParam, lParam); end; @@ -460,23 +460,23 @@ end; //------------- // Calls Translate hook //------------- -Function TCore.Retranslate(wParam, lParam: DWord): integer; +Function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; begin - Hooks.CallEventChain(hTranslate, 0, 1); + Hooks.CallEventChain(hTranslate, 1, nil); end; //------------- // Calls LoadTextures hook //------------- -Function TCore.ReloadTextures(wParam, lParam: DWord): integer; +Function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; begin - Hooks.CallEventChain(hLoadTextures, 0, 1); + 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, lParam: DWord): integer; +Function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; begin if (Pointer(lParam) = nil) then begin @@ -500,7 +500,7 @@ end; //------------- // Returns Application Handle //------------- -Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer; +Function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; begin Result := hInstance; end; diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index c30803f7..3e22bc75 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -54,13 +54,13 @@ type Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; Function DelSubscriber (const hSubscriber: THandle): Integer; - Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; + Function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; Function EventExists (const EventName: PChar): Integer; Procedure DelbyOwner(const Owner: Integer); end; -function HookTest(wParam, lParam: DWord): integer; stdcall; +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; var HookManager: THookManager; @@ -318,7 +318,7 @@ end; // CallEventChain - Calls the Chain of a specified EventHandle // Returns: -1: Handle doesn't Exist, 0 Chain is called until the End //------------ -Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; +Function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; var EventIndex: Cardinal; Cur: PSubscriberInfo; @@ -421,10 +421,10 @@ begin end; -function HookTest(wParam, lParam: DWord): integer; stdcall; +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); + Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))); end; end. diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 3fc52b8e..b0b400db 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,614 +1,616 @@ -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; - Procedure Free; override; - - //Register Modi Service - Function RegisterModi(pModiInfo, nothin: DWord): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo - - //Start new Party - Function StartParty(NumRounds, PAofIRounds: DWord): integer; //Starts new Party Mode. Returns Non Zero on Success - Function GetCurModi(wParam, lParam: DWord): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) - Function StopParty(wParam, lParam: DWord): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. - Function NextRound(wParam, lParam: DWord): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played - - Function CallModiInit(wParam, lParam: DWord): 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, lParam: DWord): integer; //Calls DeInitProc and does the RoundEnding - - Function GetTeamInfo(wParam, pTeamInfo: DWord): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success - Function SetTeamInfo(wParam, pTeamInfo: DWord): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success - - Function GetTeamOrder(wParam, lParam: DWord): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... - Function GetWinnerString(wParam, lParam: DWord): 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 - //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 -//------------- -Procedure TPartySession.Free; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Modis, 0); -end; - -//------------- -// Registers a new Modi. wParam: Pointer to TUS_ModiInfo -// Service for Plugins -//------------- -Function TPartySession.RegisterModi(pModiInfo, nothin: DWord): integer; -var - Len: Integer; - Info: PUS_ModiInfo; -begin - Info := Pointer(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.')), Integer(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, PAofIRounds: DWord): 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 := Pointer(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); - - // For I := 0 to High(NumRounds) do // eddie: changed NumRounds to Rounds - is this correct ??? I get compile errors on the mac otherwise... - 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.')), Integer(PChar('TPartySession'))); - end; - end; -end; - -//---------- -// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) -//---------- -Function TPartySession.GetCurModi(wParam, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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, lParam: DWord): 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)), Integer(PChar('TPartySession'))); - If (Rounds[CurRound].Modi = StandardModi) then - begin - Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), Integer(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, lParam: DWord): 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].ScoreTotalI > MaxScore) then - begin - MaxScore := Player[I].ScoreTotalI; - Rounds[CurRound].Winner := 1 shl I; - end - else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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, pTeamInfo: DWord): integer; -var Info: ^TTeamInfo; -begin - Result := -1; - Info := Pointer(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, pTeamInfo: DWord): integer; -var - TeamInfobackup: TTeamInfo; - Info: ^TTeamInfo; -begin - Result := -1; - Info := Pointer(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, lParam: DWord): 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, lParam: DWord): 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 (Pointer(lParam) = nil) then - begin //ReturnString Length - Result := Length(ResultStr); - end - Else - begin //Return String - Try - S := Pointer(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; + Procedure Free; 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 + //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 +//------------- +Procedure TPartySession.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Modis, 0); +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].ScoreTotalI > MaxScore) then + begin + MaxScore := Player[I].ScoreTotalI; + Rounds[CurRound].Winner := 1 shl I; + end + else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas index 56293848..6a83d7c3 100644 --- a/Game/Code/Classes/UPluginInterface.pas +++ b/Game/Code/Classes/UPluginInterface.pas @@ -26,7 +26,7 @@ uses uPluginDefs; {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, lParam: dWord): integer; stdcall; + Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; {Function Hooks an Event by Name. Returns Hook Handle on Success, otherwise 0} @@ -51,7 +51,7 @@ uses uPluginDefs; {Function Calls a Services Proc Returns Services Return Value or SERVICE_NOT_FOUND on Failure} - Function CallService (ServiceName: PChar; wParam, lParam: dWord): integer; stdcall; + Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; {Function Returns Non Zero if a Service with the given Name Exists, otherwise 0} @@ -84,7 +84,7 @@ end; // 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, lParam: dWord): integer; stdcall; +Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); end; @@ -139,7 +139,7 @@ end; // Function Calls a Services Proc // Returns Services Return Value or SERVICE_NOT_FOUND on Failure //--------------- -Function CallService (ServiceName: PChar; wParam, lParam: dWord): integer; stdcall; +Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := Core.Services.CallService(ServiceName, wParam, lParam); end; diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index 094c3fed..be1fcf2c 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -55,7 +55,7 @@ type Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; Function DelService(const hService: THandle): integer; - Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; + Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; Function NametoHash(const ServiceName: TServiceName): Integer; Function ServiceExists(const ServiceName: PChar): Integer; @@ -210,7 +210,7 @@ end; // Function Calls a Services Proc // Returns Services Return Value or SERVICE_NOT_FOUND on Failure //------------ -Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; +Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; var SExists: Integer; Service: PServiceInfo; diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 87951fed..b018ccc2 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -65,10 +65,10 @@ type Procedure CallDeInit(Index: Cardinal); //Services offered - Function LoadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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)) + 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; @@ -163,7 +163,7 @@ begin BrowseDir(PluginPath); Except Result := False; - Core.ReportError(Integer(PChar('Error Browsing and Loading.')), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader')); end; end; @@ -279,7 +279,7 @@ begin PInfo(@Info); Except Info.Name := ''; - Core.ReportError(Integer(PChar('Error getting Plugin Info: ' + Filename)), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader')); end; //Is Name set ? @@ -312,7 +312,7 @@ begin begin Plugins[PluginID].State := 255; FreeLibrary(hLib); - Core.ReportError(Integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), Integer(PChar('TPluginLoader'))); + 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 @@ -326,10 +326,10 @@ begin 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))), Integer(PChar('TPluginLoader'))); + Core.ReportDebug(Integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader')); //Unload Old Plugin - UnloadPlugin(Integer(nil), PluginID); + UnloadPlugin(PluginID, nil); //Fill with new Info Plugins[PluginID].Info := Info; @@ -347,7 +347,7 @@ begin begin FreeLibrary(hLib); Plugins[PluginID].State := 255; - Core.ReportError(Integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); end; end else @@ -358,23 +358,23 @@ begin else begin FreeLibrary(hLib); - Core.ReportError(Integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), Integer(PChar('TPluginLoader'))); + 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)), Integer(PChar('TPluginLoader'))); + 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)), Integer(PChar('TPluginLoader'))); + 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)), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader')); end; end; @@ -400,7 +400,7 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(Integer(PChar('Error calling Load Function from Plugin: ' + String(Plugins[Index].Info.Name))), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Error calling Load Function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -431,7 +431,7 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(Integer(PChar('Error calling Init Function from Plugin: ' + String(Plugins[Index].Info.Name))), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Error calling Init Function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -478,9 +478,9 @@ end; //-------------- -// wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin //-------------- -Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; +Function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: Integer; sFile: String; @@ -488,14 +488,14 @@ begin Result := -1; sFile := ''; //lParam is ID - If (Pointer(wParam) = nil) then + If (lParam = nil) then begin - Index := lParam; + Index := wParam; end else - begin //wParam is PChar + begin //lParam is PChar try - sFile := String(PChar(Pointer(wParam))); + sFile := String(PChar(lParam)); Index := PluginExists(sFile); If (Index < 0) And FileExists(sFile) then begin //Is Filename @@ -516,23 +516,23 @@ begin end; //-------------- -// wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin //-------------- -Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; +Function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: Integer; sName: String; begin Result := -1; //lParam is ID - If (Pointer(wParam) = nil) then + If (lParam = nil) then begin - Index := lParam; + Index := wParam; end else begin //wParam is PChar try - sName := String(PChar(Pointer(wParam))); + sName := String(PChar(lParam)); Index := PluginExists(sName); except Index := -2; @@ -547,23 +547,23 @@ 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, lParam: DWord): integer; +Function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; var I: Integer; begin Result := 0; - If (wParam < 0) then + If (wParam > 0) then begin //Get Info of 1 Plugin - If (Pointer(lParam) <> nil) AND (wParam < Length(Plugins)) then + If (lParam <> nil) AND (wParam < Length(Plugins)) then begin Try Result := 1; - PUS_PluginInfo(Pointer(lParam))^ := Plugins[wParam].Info; + PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; Except End; end; end - Else If (Pointer(lParam) = nil) then + Else If (lParam = nil) then begin //Get Length of Plugin (Info) Array Result := Length(Plugins); end @@ -571,10 +571,10 @@ begin begin Try For I := 0 to high(Plugins) do - PAUS_PluginInfo(Pointer(lParam))^[I] := Plugins[I].Info; + PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; Result := Length(Plugins); Except - Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); End; end; @@ -583,18 +583,18 @@ 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, lParam: DWord): integer; +Function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; var I: Integer; begin Result := -1; - If (wParam < 0) then + If (wParam > 0) then begin //Get State of 1 Plugin If (wParam < Length(Plugins)) then begin Result := Plugins[wParam].State; end; end - Else If (Pointer(lParam) = nil) then + Else If (lParam = nil) then begin //Get Length of Plugin (Info) Array Result := Length(Plugins); end @@ -602,10 +602,10 @@ begin begin Try For I := 0 to high(Plugins) do - Byte(Pointer(lParam + I)^) := Plugins[I].State; + Byte(Pointer(Integer(lParam) + I)^) := Plugins[I].State; Result := Length(Plugins); Except - Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(PChar('TPluginLoader'))); + Core.ReportError(Integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader')); End; end; end; @@ -654,7 +654,7 @@ begin If (PluginLoader = nil) then begin Result := False; - Core.ReportError(Integer(PChar('Could not get Pointer to PluginLoader')), Integer(PChar('TtehPlugins'))); + Core.ReportError(Integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins')); end else begin @@ -676,10 +676,10 @@ begin 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))), Integer(PChar('TtehPlugins'))); + Core.ReportDebug(Integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[I].Info.Name))), PChar('TtehPlugins')); end else - Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins'))); + Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), PChar('TtehPlugins')); Inc(I); end; @@ -690,7 +690,7 @@ begin 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 + '"')), Integer(PChar('TtehPlugins'))); + Core.ReportError(Integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[I].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); //don't forget to increase I @@ -736,10 +736,10 @@ begin 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))), Integer(PChar('TtehPlugins'))); + 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))), Integer(PChar('TtehPlugins'))); + Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), PChar('TtehPlugins')); //don't forget to increase I Inc(I); @@ -749,7 +749,7 @@ begin // => 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))), Integer(PChar('TtehPlugins'))); + Core.ReportError(Integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[I].Info.Name))), PChar('TtehPlugins')); //don't forget to increase I Inc(I); -- cgit v1.2.3 From 6ca1db26350a589b5bcb3e2eac35a7965d5ab448 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 18:51:40 +0000 Subject: Mac OS X: Added PseudoThread for debugging, because debugging of threaded code causes problems with Xcode and FreePascal. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@594 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommandLine.pas | 4 ++++ Game/Code/Classes/URecord.pas | 10 ++++++++++ Game/Code/Classes/USongs.pas | 25 ++++++++++++++++++++++--- 3 files changed, 36 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 1539ffaf..01ece795 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -2,6 +2,10 @@ unit UCommandLine; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 87c35cd8..29a9d7f9 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -323,6 +323,16 @@ begin BASS_RecordInit(SC); InputName := BASS_RecordGetInputName(SCI); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then + begin + InputName := 'Microphone'; + end; + {$ENDIF} SetLength(SoundCard[SC].Input, 1); SoundCard[SC].Input[SCI].Name := InputName; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index a04c1032..9b9ab7bb 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -8,6 +8,12 @@ interface {$I switches.inc} +{$IFDEF DARWIN} + {$IFDEF DEBUG} + {$DEFINE USE_PSEUDO_THREAD} + {$ENDIF} +{$ENDIF} + uses {$IFDEF MSWINDOWS} Windows, @@ -30,6 +36,9 @@ uses {$IFDEF DARWIN} cthreads, {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} UCatCovers; type @@ -86,8 +95,13 @@ type OrderTyp: integer; // type of sorting for this button (0=name) CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs end; - + + + {$IFDEF USE_PSEUDO_THREAD} + TSongs = class( TPseudoThread ) + {$ELSE} TSongs = class( TThread ) + {$ENDIF} private BrowsePos : Cardinal; //Actual Pos in Song Array fNotify , @@ -204,7 +218,9 @@ begin *) {$endif} - Setlength(Song, 0); +{$IFNDEF USE_PSEUDO_THREAD} + Setlength(Song, 0); +{$ENDIF} end; procedure TSongs.DoDirChanged(Sender: TObject); @@ -216,6 +232,9 @@ procedure TSongs.Execute(); var fChangeNotify : THandle; begin +{$IFDEF USE_PSEUDO_THREAD} + int_LoadSongList(); +{$ELSE} fParseSongDirectory := true; while not self.terminated do @@ -229,7 +248,7 @@ begin self.suspend; end; - +{$ENDIF} end; procedure TSongs.int_LoadSongList; -- cgit v1.2.3 From a0ff0b75e3562e04f17f11fc41f2e49040d620c5 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:02:07 +0000 Subject: Added UPlatform.pas. This should be the first step to move the simple platform specific code to one file for each platform to reduce the IFDEFs in the remaining files. The first available function is a unicode capable DirectoryFindFiles. It is now used in the BrowseDir function in file USongs.pas. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@595 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 3 - Game/Code/Classes/UPlatform.pas | 56 +++++++++ Game/Code/Classes/UPlatformLinux.pas | 66 ++++++++++ Game/Code/Classes/UPlatformMacOSX.pas | 66 ++++++++++ Game/Code/Classes/UPlatformWindows.pas | 58 +++++++++ Game/Code/Classes/USongs.pas | 222 ++++++--------------------------- 6 files changed, 284 insertions(+), 187 deletions(-) create mode 100644 Game/Code/Classes/UPlatform.pas create mode 100644 Game/Code/Classes/UPlatformLinux.pas create mode 100644 Game/Code/Classes/UPlatformMacOSX.pas create mode 100644 Game/Code/Classes/UPlatformWindows.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index f25eaa87..c11b68d9 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -12,9 +12,6 @@ uses {$IFDEF MSWINDOWS} Windows, {$ENDIF} - {$IFDEF DARWIN} // needed for initialization of cthreads - cthreads, - {$ENDIF} SDL, UGraphic, UMusic, diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas new file mode 100644 index 00000000..cc971bed --- /dev/null +++ b/Game/Code/Classes/UPlatform.pas @@ -0,0 +1,56 @@ +unit UPlatform; + +// Comment by Eddie: +// This unit defines an interface for platform specific utility functions. +// The Interface is implemented in separate files for each platform: +// UPlatformWindows, UPlatformLinux and UPlatformWindows. + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes; + +type + + TDirectoryEntry = Record + Name : WideString; + IsDirectory : Boolean; + IsFile : Boolean; + end; + + TDirectoryEntryArray = Array of TDirectoryEntry; + + IPlatform = interface + + // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. + // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false + // directories are completely ignored. + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + end; + +var + Platform : IPlatform; + +implementation + +uses + {$IFDEF MSWINDOWS} + UPlatformWindows; + {$ENDIF} + {$IFDEF LINUX} + UPlatformLinux; + {$ENDIF} + {$IFDEF DARWIN} + UPlatformMacOSX; + {$ENDIF} + +initialization + + Platform := TPlatform.Create; + +end. diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas new file mode 100644 index 00000000..1713df1c --- /dev/null +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -0,0 +1,66 @@ +unit UPlatformLinux; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatform = class(TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + end; + +implementation + +uses SysUtils, oldlinux; + +Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; + Entry : Longint; + info : oldlinux.stat; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := oldlinux.opendir( Dir ); + if Assigned(TheDir) then + repeat + ADirent := oldlinux.ReadDir(TheDir); + + If Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + Until ADirent = nil; + + oldlinux.CloseDir(TheDir); +end; + +end. diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas new file mode 100644 index 00000000..56469299 --- /dev/null +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -0,0 +1,66 @@ +unit UPlatformMacOSX; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatform = class(TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + end; + +implementation + +uses SysUtils, baseunix; + +Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : pdir; + ADirent : pDirent; + Entry : Longint; + info : stat; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FPOpenDir(Dir); + if Assigned(TheDir) then + repeat + ADirent := FPReadDir(TheDir); + + If Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + Until ADirent = nil; + + FPCloseDir(TheDir); +end; + +end. diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas new file mode 100644 index 00000000..eb432335 --- /dev/null +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -0,0 +1,58 @@ +unit UPlatformWindows; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatform = class(TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + end; + +implementation + +uses SysUtils, Windows; + +Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + SR : TSearchRecW; +begin + i := 0; + Filter := LowerCase(Filter); + + if ReturnAllSubDirs then begin + if FindFirstW(Dir + '*', faDirectory, SR) = 0 then + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + SetLength( Result, i + 1); + Result[i].Name := SR.Name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end; + until FindNextW(SR) <> 0; + FindCloseW(SR); + end; + + if FindFirstW(Dir + '*' + Filter, 0, SR) = 0 then + repeat + SetLength( Result, i + 1); + Result[i].Name := SR.Name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + until FindNextW(SR) <> 0; + FindCloseW(SR); +end; + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 9b9ab7bb..dcca08bd 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -30,6 +30,7 @@ uses {$ENDIF} SysUtils, Classes, + UPlatform, ULog, UTexture, UCommon, @@ -299,198 +300,51 @@ begin self.resume; end; -// TODO : JB - THis whole function SUX ! and needs refactoring ! :P procedure TSongs.BrowseDir(Dir: widestring); var SLen: integer; - - {$ifdef Delphi} - SR: TSearchRecW; // for parsing Songs Directory - {$ENDIF} - - // eddie: can we merge that? is baseunix working on linux? oldlinux is - // not available on mac os x. - {$IFDEF LINUX} - TheDir : oldlinux.pdir; - ADirent : oldlinux.pDirent; - Entry : Longint; - info : oldlinux.stat; - {$ENDIF} - {$IFDEF DARWIN} - TheDir : pdir; - ADirent : pDirent; - Entry : Longint; - info : stat; - lAttrib : integer; - {$ENDIF} + i : Integer; + Files : TDirectoryEntryArray; begin - {$ifdef Delphi} - if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows - begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - begin - BrowseDir(Dir + Sr.Name + PathDelim); - end - until FindNextw(SR) <> 0; - end; // if - FindClosew(SR); - - if FindFirstW(Dir + '*.txt', 0, SR) = 0 then - begin - repeat - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := SR.Name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - - until FindNextW(SR) <> 0; - end; // if FindFirst - FindCloseW(SR); - {$ENDIF} - - {$IFDEF LINUX} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - If ADirent<>Nil then - begin - With ADirent^ do - begin - - if ( name[0] <> '.') then - BrowseDir( Dir + name + pathdelim ); - - end; - end; - Until ADirent=Nil; - end; - - - - TheDir := oldlinux.opendir( Dir ); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := oldlinux.ReadDir(TheDir); - - if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.name ) > 0 ) then - begin - writeln ('***** FOUND TXT' + ADirent^.name ); - - SLen := BrowsePos; - - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.name; - - if (AnalyseFile(Song[SLen]) = false) then - Dec(BrowsePos) - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - - Until ADirent=Nil; - end; // if FindFirst - {$endif} - - {$IFDEF DARWIN} - // Itterate the Songs Directory... ( With unicode capable functions for linux ) - TheDir := FPOpenDir(Dir); // JB_Unicode - linux - if TheDir <> nil then - begin - repeat - ADirent := FPReadDir(TheDir); - - If assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); - if (lAttrib and faDirectory) <> 0 then - begin - //Log.LogError('Entering dir "' + Dir + ADirent^.d_name + PathDelim + '" now.'); - BrowseDir(Dir + ADirent^.d_name + PathDelim); - end - else if Pos( '.txt', LowerCase(ADirent^.d_name)) > 0 then - begin - SLen := BrowsePos; - - try - Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(String(Dir), Length(String(SongPath))+1, 10000); - Song[SLen].Folder := Copy(String(Song[SLen].Folder), 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := ADirent^.d_name; - //Log.LogError( 'Song: ' + ADirent^.d_name + ', Length(Song) = ' + inttostr(Length(Song)) + ', BrowsePos = ' + IntToStr(BrowsePos) + ', Dir = "' + Dir + '"'); - - if (AnalyseFile(Song[SLen]) = false) then - begin - Log.LogError('AnalyseFile failed for "' + ADirent^.d_name + '".'); - Dec(BrowsePos); - end - else - begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); - end; - except - end; - - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; - end; - end; - - Until ADirent=Nil; - - if (FPCloseDir(TheDir) <> 0) then + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseDir( Dir + Files[i].Name + PathDelim ); + end + else begin - Log.LogError('TSongs.BrowseDir: Exception: Error closing dir: "' + Dir + '".') + SLen := BrowsePos; + + Song[SLen].Path := Dir; + Song[SLen].Folder := Copy(String(Dir), Length(String(SongPath))+1, 10000); + Song[SLen].Folder := Copy(String(Song[SLen].Folder), 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].FileName := Files[i].Name; + + if (AnalyseFile(Song[SLen]) = false) then + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + Dec(BrowsePos); + end + else + begin + if Song[SLen].Cover = '' then + Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + end; + + //Change Length Only every 50 Entrys + Inc(BrowsePos); + + if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then + begin + SetLength(Song, Length(Song) + 50); + end; end; - end; + end; + SetLength( Files, 0); - {$endif} - // Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); - - end; procedure TSongs.Sort(Order: integer); -- cgit v1.2.3 From d2254ffc1eb4bfe47ee68311eea21892b1bcc5d9 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:09:23 +0000 Subject: Added missing functions. I Hope this fixes the build on Windows. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@596 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformWindows.pas | 70 ++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index eb432335..c7965761 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -11,6 +11,16 @@ interface uses Classes, UPlatform; type + + TSearchRecW = record + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; TPlatform = class(TInterfacedObject, IPlatform) public @@ -21,6 +31,66 @@ implementation uses SysUtils, Windows; +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; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + 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 + if FindNextFileW(F.FindHandle, F.FindData) then + 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 + if not FindNextFileW(FindHandle, FindData) then + 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; + Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; var i : Integer; -- cgit v1.2.3 From 5b4785d36f83f3361f89b33c84839591969d24a6 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:15:01 +0000 Subject: Changed d_name to name. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@597 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 1713df1c..fd06097d 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -38,21 +38,21 @@ begin repeat ADirent := oldlinux.ReadDir(TheDir); - If Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + If Assigned(ADirent) and (ADirent^.name <> '.') and (ADirent^.name <> '..') then begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); + lAttrib := FileGetAttr(Dir + ADirent^.name); if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then begin SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; + Result[i].Name := ADirent^.name; Result[i].IsDirectory := true; Result[i].IsFile := false; i := i + 1; end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.name)) > 0) then begin SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; + Result[i].Name := ADirent^.name; Result[i].IsDirectory := false; Result[i].IsFile := true; i := i + 1; -- cgit v1.2.3 From b2a203f519a2a4d13ffdad2cedb9fcfa2d07db8b Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:21:20 +0000 Subject: Move the TSearchRecW record to the implementation part. This should fix the compilation error. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@598 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformWindows.pas | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index c7965761..1786d6cc 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -10,6 +10,17 @@ interface uses Classes, UPlatform; +type + + TPlatform = class(TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + end; + +implementation + +uses SysUtils, Windows; + type TSearchRecW = record @@ -22,14 +33,6 @@ type FindData: TWin32FindDataW; end; - TPlatform = class(TInterfacedObject, IPlatform) - public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; - end; - -implementation - -uses SysUtils, Windows; function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; const -- cgit v1.2.3 From e83126a1e93f274c32e4a243f93d1dc2bcb63c44 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:25:57 +0000 Subject: Added forward declarations... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@599 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformWindows.pas | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index 1786d6cc..f78b87ec 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -33,6 +33,11 @@ type 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 -- cgit v1.2.3 From fad9bf088ffa01246ca1ada66a0c1ab81f07108b Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 21:56:26 +0000 Subject: Removed the String() casts. Now BrowseDir is unicode capable again. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@600 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index dcca08bd..0ffa2a8d 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -318,8 +318,8 @@ begin SLen := BrowsePos; Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(String(Dir), Length(String(SongPath))+1, 10000); - Song[SLen].Folder := Copy(String(Song[SLen].Folder), 1, Pos( PathDelim , Song[SLen].Folder)-1); + Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); Song[SLen].FileName := Files[i].Name; if (AnalyseFile(Song[SLen]) = false) then -- cgit v1.2.3 From fba9a67e3718a65594dc7969dac952ce5cca99d8 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 8 Nov 2007 23:18:12 +0000 Subject: Fixed song loading on Windows. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@601 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformWindows.pas | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index f78b87ec..7e65d700 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -103,32 +103,33 @@ Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs var i : Integer; SR : TSearchRecW; + lAttrib : Integer; begin i := 0; Filter := LowerCase(Filter); - if ReturnAllSubDirs then begin - if FindFirstW(Dir + '*', faDirectory, SR) = 0 then - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then + 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].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; - until FindNextW(SR) <> 0; - FindCloseW(SR); - end; - - if FindFirstW(Dir + '*' + Filter, 0, SR) = 0 then - repeat - SetLength( Result, i + 1); - Result[i].Name := SR.Name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; + end; until FindNextW(SR) <> 0; FindCloseW(SR); end; -- cgit v1.2.3 From e7b509d9fcf5251f19cad8465b80792463932d06 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sun, 11 Nov 2007 23:00:17 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@603 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 998a1d4b..040a0cdb 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -271,15 +271,12 @@ begin // Resolution SetLength(IResolution, 0); Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - repeat + while Assigned(Modes) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin SetLength(IResolution, Length(IResolution) + 1); IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); - - Log.LogStatus('SDL_ListModes Res : ' + IResolution[High(IResolution)], 'Graphics - Resolutions'); - Inc(Modes); - until Modes^ = nil; + end; // if no modes were set, then failback to 800x600 // as per http://sourceforge.net/forum/message.php?msg_id=4544965 -- cgit v1.2.3 From 318b273351e334c61ebf114508044043ee96cb35 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 19 Nov 2007 00:29:54 +0000 Subject: fixed bug in UIni ( on linux at least ) todo with SDL Initialization. Modifed Theme selection screen, so ALL theme options are runtime changable. ( Without restart ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@610 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 040a0cdb..ef135e65 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -270,8 +270,9 @@ begin // Resolution SetLength(IResolution, 0); + Modes^ := nil; Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - while Assigned(Modes) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) begin SetLength(IResolution, Length(IResolution) + 1); IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); -- cgit v1.2.3 From 4359220f85163f438c33afc0b2d78fa852ff6ef8 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 19 Nov 2007 10:31:08 +0000 Subject: fix run time bug git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@611 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index ef135e65..444eef32 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -270,8 +270,8 @@ begin // Resolution SetLength(IResolution, 0); - Modes^ := nil; - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) begin SetLength(IResolution, Length(IResolution) + 1); -- cgit v1.2.3 From 34b0cb8bd025b40f52cff91bd9c29cd02faee7c2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 20 Nov 2007 13:04:13 +0000 Subject: promoted changes from fisheye#614 to the main trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@615 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UThemes.pas | 92 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index c212e7cb..f7b08479 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -659,6 +659,7 @@ type {$ENDIF} LastThemeBasic: TThemeBasic; + procedure create_theme_objects(); public Loading: TThemeLoading; @@ -801,6 +802,8 @@ var Path: string; begin Result := false; + + create_theme_objects(); FileName := AdaptFilePaths( FileName ); @@ -2210,5 +2213,94 @@ begin DecimalSeparator := ','; 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. -- cgit v1.2.3 From ce484ce148d1db51ddb3cda575786f0871843cb3 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Tue, 20 Nov 2007 21:02:37 +0000 Subject: Changed Platform from Interface to Class. Added TerminateIfAlreadyRunning and GetGamePath to UPlatform.pas. Fixed a bug in THookManager.Create ("SpacetoAllocate-1"). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@617 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 92 ++-------------------------------- Game/Code/Classes/UHooks.pas | 2 +- Game/Code/Classes/UMain.pas | 55 ++------------------ Game/Code/Classes/UPlatform.pas | 46 ++++++++++++++--- Game/Code/Classes/UPlatformLinux.pas | 6 +-- Game/Code/Classes/UPlatformMacOSX.pas | 26 ++++++++-- Game/Code/Classes/UPlatformWindows.pas | 35 +++++++++++-- 7 files changed, 105 insertions(+), 157 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 65d98e30..fb74af0b 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -64,24 +64,7 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} -{$IFNDEF FPC} -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; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; -{$endif} +// eddie: FindFirstW etc are now in UPlatformWindows.pas implementation @@ -225,77 +208,8 @@ end; procedure DeallocateHWnd(Wnd: HWND); begin end; -{$ENDIF} - - - - -{$ENDIF} - -{$ifNdef FPC} -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; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - 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 - if FindNextFileW(F.FindHandle, F.FindData) then - 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 - if not FindNextFileW(FindHandle, FindData) then - 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; -{$endif} - - - +{$ENDIF} // IFDEF DARWIN +{$ENDIF} // IFDEF FPC end. diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index 3e22bc75..8b33959d 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -76,7 +76,7 @@ var I: Integer; begin //Get the Space and "Zero" it SetLength (Events, SpacetoAllocate); - For I := 0 to SpacetoAllocate do + For I := 0 to SpacetoAllocate-1 do Events[I].Name[1] := chr(0); SpaceinEvents := SpacetoAllocate; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index c11b68d9..019e638a 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -125,7 +125,7 @@ implementation uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, - UParty, UCore, UGraphicClasses, UPluginDefs; + UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; const Version = 'UltraStar Deluxe V 1.10 Alpha Build'; @@ -133,36 +133,14 @@ const Procedure Main; var WndTitle: string; - hWnd: THandle; - I: Integer; begin try WndTitle := Version; - {$IFDEF MSWINDOWS} - //------------------------------ - //Start more than One Time Prevention - //------------------------------ - 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 - Exit; - end; - {$ENDIF} - + if Platform.TerminateIfAlreadyRunning( {var} WndTitle) then + Exit; + //------------------------------ //StartUp - Create Classes and Load Files //------------------------------ @@ -1008,25 +986,6 @@ begin Player[PlayerNum].ScoreTotalI := 0; end; -{$IFDEF DARWIN} -// Mac applications are packaged in directories. -// We have to cut the last two directories -// to get the application directory. -Function GetGamePath : String; -var - x, - i : integer; -begin - Result := ExtractFilePath(ParamStr(0)); - for x := 0 to 2 do begin - i := Length(Result); - repeat - Delete( Result, i, 1); - i := Length(Result); - until (i = 0) or (Result[i] = '/'); - end; -end; -{$ENDIF} //-------------------- // Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist @@ -1062,11 +1021,7 @@ procedure InitializePaths; begin -{$IFDEF DARWIN} - GamePath := GetGamePath; -{$ELSE} - GamePath := ExtractFilePath(ParamStr(0)); -{$ENDIF} + GamePath := Platform.GetGamePath; initialize_path( LogPath , GamePath ); initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas index cc971bed..878c1ec2 100644 --- a/Game/Code/Classes/UPlatform.pas +++ b/Game/Code/Classes/UPlatform.pas @@ -25,20 +25,25 @@ type TDirectoryEntryArray = Array of TDirectoryEntry; - IPlatform = interface - - // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. - // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false - // directories are completely ignored. - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + TPlatform = class + + // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. + // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false + // directories are completely ignored. + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; virtual; abstract; + + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; virtual; + + function GetGamePath : WideString; virtual; end; var - Platform : IPlatform; + Platform : TPlatform; implementation uses + SysUtils, {$IFDEF MSWINDOWS} UPlatformWindows; {$ENDIF} @@ -49,8 +54,33 @@ uses UPlatformMacOSX; {$ENDIF} +{ TPlatform } + +function TPlatform.GetGamePath: WideString; +begin + // Windows and Linux use this: + Result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatform.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; +begin + // Linux and Mac don't check for running apps at the moment + Result := false; +end; + initialization - Platform := TPlatform.Create; + {$IFDEF MSWINDOWS} + Platform := TPlatformWindows.Create; + {$ENDIF} + {$IFDEF LINUX} + Platform := TPlatformLinux.Create; + {$ENDIF} + {$IFDEF DARWIN} + Platform := TPlatformMacOSX.Create; + {$ENDIF} + +finalization + Platform.Free; end. diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index fd06097d..e6d90e20 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -12,16 +12,16 @@ uses Classes, UPlatform; type - TPlatform = class(TInterfacedObject, IPlatform) + TPlatform = class(TPlatform) public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; end; implementation uses SysUtils, oldlinux; -Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; var i : Integer; TheDir : oldlinux.pdir; diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index 56469299..4e0c9061 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -12,16 +12,36 @@ uses Classes, UPlatform; type - TPlatform = class(TInterfacedObject, IPlatform) + TPlatformMacOSX = class(TPlatform) + private public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + function GetGamePath: WideString; override; end; implementation uses SysUtils, baseunix; -Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +// Mac applications are packaged in directories. +// We have to cut the last two directories +// to get the application directory. +Function TPlatformMacOSX.GetGamePath : WideString; +var + x, + i : integer; +begin + Result := ExtractFilePath(ParamStr(0)); + for x := 0 to 2 do begin + i := Length(Result); + repeat + Delete( Result, i, 1); + i := Length(Result); + until (i = 0) or (Result[i] = '/'); + end; +end; + +Function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; var i : Integer; TheDir : pdir; diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index 7e65d700..afdcebcf 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -12,9 +12,10 @@ uses Classes, UPlatform; type - TPlatform = class(TInterfacedObject, IPlatform) + TPlatformWindows = class(TPlatform) public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; override; end; implementation @@ -99,7 +100,35 @@ begin Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); end; -Function TPlatform.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +//------------------------------ +//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; -- cgit v1.2.3 From d3e475ad32f82e770981b8035621ce52d8faccae Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Tue, 20 Nov 2007 21:08:33 +0000 Subject: Fixed UPlatformLinux.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@618 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index e6d90e20..741662cd 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -12,7 +12,7 @@ uses Classes, UPlatform; type - TPlatform = class(TPlatform) + TPlatformLinux = class(TPlatform) public Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; end; -- cgit v1.2.3 From 974acf9d30f717e99a9320d2f975141d399feb98 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Tue, 20 Nov 2007 21:21:58 +0000 Subject: Removed Windows.pas include git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@619 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 3 --- 1 file changed, 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 019e638a..924ef0ab 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -9,9 +9,6 @@ interface {$I switches.inc} uses - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} SDL, UGraphic, UMusic, -- cgit v1.2.3 From a224f217974a1d7e523f104fcfe1010a6f2143ef Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 21 Nov 2007 18:31:32 +0000 Subject: Solved Usdx-1 in Trunk and 1.0.1 ChannelOptions now 'Off', '1', '2', '3'.. instead of '0', '1', '2', '3'.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@622 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 1588 ++++++++++++++++++++++---------------------- 1 file changed, 794 insertions(+), 794 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 444eef32..f1b73d38 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -1,794 +1,794 @@ -unit UIni; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses IniFiles, ULog, SysUtils; - -type - TIni = class - Name: array[0..11] of string; - - // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; - - //Filename of the opened iniFile - Filename: string; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - Threshold: integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - - // Record - Card: integer; // not saved in config.ini - - CardList: array of record - Name: string; - Input: integer; - ChannelL: integer; - ChannelR: integer; - end; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskbeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - - // Soundcards - SoundCard: array[0..7, 1..2] of integer; - - // Devices - LPT: integer; - - procedure Load; - procedure Save; - procedure SaveNames; - procedure SaveLevel; - end; - - -var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - ICard: array of string; - IInput: array of string; - -const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); - - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; - - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ISingWindow: array[0..1] of string = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); - //IOscilloscope: array[0..1] of string = ('Off', 'On'); - - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - - - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array [0..1] of String =('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); - - IJoypad: array[0..1] of string = ('Off', 'On'); - ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); - - IChannel: array[0..6] of string = ('0', '1', '2', '3', '4', '5', '6'); - -implementation - -uses //UFiles, - UMain, - SDL, - ULanguage, - USkins, - URecord, - UCommandLine; - -procedure TIni.Load; -var - IniFile: TMemIniFile; - ThemeIni: TMemIniFile; - Tekst: string; - Pet: integer; - B: boolean; - I, I2, I3: integer; - S: string; - Modes: PPSDL_Rect; - SR: TSearchRec; //Skin List Patch - - function GetFileName (S: String):String; - begin - //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); - Result := copy (S,0,Pos ('.ini',S)-1); - end; - -begin - GamePath := ExtractFilePath(ParamStr(0)); - - if (Params.ConfigFile <> '') then - try - IniFile := TMemIniFile.Create(Params.ConfigFile); - except - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - end - else - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - - - // Name - for I := 0 to 11 do - Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - - // Templates for Names Mod - for I := 0 to 2 do - Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); - for Pet := 0 to High(IPlayers) do - if Tekst = IPlayers[Pet] then Ini.Players := Pet; - - // Difficulty - Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); - for Pet := 0 to High(IDifficulty) do - if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; - - // Language - Tekst := IniFile.ReadString('Game', 'Language', 'English'); - for Pet := 0 to High(ILanguage) do - if Tekst = ILanguage[Pet] then Ini.Language := Pet; - -// Language.ChangeLanguage(ILanguage[Ini.Language]); - - // Tabs - Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); - for Pet := 0 to High(ITabs) do - if Tekst = ITabs[Pet] then Ini.Tabs := Pet; - - //Tabs at Startup fix - Ini.Tabs_at_startup := Ini.Tabs; - - // Sorting - Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); - for Pet := 0 to High(ISorting) do - if Tekst = ISorting[Pet] then Ini.Sorting := Pet; - - // Debug - Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); - for Pet := 0 to High(IDebug) do - if Tekst = IDebug[Pet] then Ini.Debug := Pet; - - //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; - - // Screens - Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); - for Pet := 0 to High(IScreens) do - if Tekst = IScreens[Pet] then Ini.Screens := Pet; - - // FullScreen - Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); - for Pet := 0 to High(IFullScreen) do - if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; - - - // Resolution - SetLength(IResolution, 0); - - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - end; - - // if no modes were set, then failback to 800x600 - // as per http://sourceforge.net/forum/message.php?msg_id=4544965 - // THANKS : linnex at users.sourceforge.net - if Length(IResolution) < 1 then - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); - Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); - - // Default to fullscreen OFF, in this case ! - Ini.FullScreen := 0; - end; - - // reverse order - for I := 0 to (Length(IResolution) div 2) - 1 do begin - S := IResolution[I]; - IResolution[I] := IResolution[High(IResolution)-I]; - IResolution[High(IResolution)-I] := S; - end; - - Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - for Pet := 0 to High(IResolution) do - if Tekst = IResolution[Pet] then Ini.Resolution := Pet; - - - // Resolution - Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); - for Pet := 0 to High(IDepth) do - if Tekst = IDepth[Pet] then Ini.Depth := Pet; - - // Texture Size - Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); - for Pet := 0 to High(ITextureSize) do - if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; - - // SingWindow - Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); - for Pet := 0 to High(ISingWindow) do - if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; - - // Oscilloscope - Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); - for Pet := 0 to High(IOscilloscope) do - if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; - - // Spectrum - Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); - for Pet := 0 to High(ISpectrum) do - if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; - - // Spectrograph - Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); - for Pet := 0 to High(ISpectrograph) do - if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; - - // MovieSize - Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); - for Pet := 0 to High(IMovieSize) do - if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; - - // MicBoost - Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); - for Pet := 0 to High(IMicBoost) do - if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; - - // ClickAssist - Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); - for Pet := 0 to High(IClickAssist) do - if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; - - // BeatClick - Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); - for Pet := 0 to High(IBeatClick) do - if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; - - // SavePlayback - Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); - for Pet := 0 to High(ISavePlayback) do - if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; - - // Threshold - Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); - for Pet := 0 to High(IThreshold) do - if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; - - //Song Preview - Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); - for Pet := 0 to High(IPreviewVolume) do - if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; - - Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); - for Pet := 0 to High(IPreviewFading) do - if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; - - // Lyrics Font - Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); - for Pet := 0 to High(ILyricsFont) do - if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; - - // Lyrics Effect - Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); - for Pet := 0 to High(ILyricsEffect) do - if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; - - // Solmization - Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); - for Pet := 0 to High(ISolmization) do - if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; - - // Theme - - //Theme List Patch - - //I2 Saves the no of the Deluxe (Standard-) Theme - I2 := 0; - //I counts is the cur. Theme no - I := 0; - - SetLength(ITheme, 0); - FindFirst('Themes' + PathDelim + '*.ini',faAnyFile,SR); - Repeat - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SR.Name); - Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); - ThemeIni.Free; - - //if Deluxe Theme then save Themeno to I2 - if (Tekst = 'DELUXE') then - I2 := I; - - //Search for Skins for this Theme - for Pet := low(Skin.Skin) to high(Skin.Skin) do - begin - if UpperCase(Skin.Skin[Pet].Theme) = Tekst then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := GetFileName(SR.Name); - break; - end; - end; - - Inc(I); - Until FindNext(SR) <> 0; - FindClose(SR); - //Theme List Patch End } - - //No Theme Found - if (Length(ITheme)=0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - - Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); - Ini.Theme := 0; - for Pet := 0 to High(ITheme) do - if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; - - // Skin - Skin.onThemeChange; - Ini.SkinNo := 0; - - Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); - for Pet := 0 to High(ISkin) do - if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; - - // Color - Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); - for Pet := 0 to High(IColor) do - if Tekst = IColor[Pet] then Ini.Color := Pet; - - // Record - load ini list - SetLength(CardList, 0); - I := 1; - while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin - //Automatically Delete not Existing Sound Cards - S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); - //{ - B := False; - //Look for Soundcard - for I2 := 0 to High(Recording.SoundCard) do - begin - if (S = Trim(Recording.SoundCard[I2].Description)) then - begin - B := True; - Break; - end; - end; - - if B then - begin //} - I3 := Length(CardList); - SetLength(CardList, I3+1); - Ini.CardList[I3].Name := S; - Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); - Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); - Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); - end; - Inc(I); - end; - - // Record - append detected soundcards - for I := 0 to High(Recording.SoundCard) do - begin - B := False; - For I2 := 0 to High(CardList) do - begin //Search for Card in List - if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then - begin - B := True; - Break; - end; - end; - - //If not in List -> Add - If not B then - begin - I3 := Length(CardList); - SetLength(CardList, I3+1); - CardList[I3].Name := Trim(Recording.SoundCard[I].Description); - CardList[I3].Input := 0; - CardList[I3].ChannelL := 0; - CardList[I3].ChannelR := 0; - // default for new users - if (Length(CardList) = 1) then - CardList[I].ChannelL := 1; - end; - end; - - //Advanced Settings - - // LoadAnimation - Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); - for Pet := 0 to High(ILoadAnimation) do - if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; - - // ScreenFade - Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); - for Pet := 0 to High(IScreenFade) do - if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; - - // EffectSing - Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); - for Pet := 0 to High(IEffectSing) do - if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; - - // AskbeforeDel - Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); - for Pet := 0 to High(IAskbeforeDel) do - if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; - - // OnSongClick - Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); - for Pet := 0 to High(IOnSongClick) do - if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; - - // Linebonus - Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); - for Pet := 0 to High(ILineBonus) do - if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - - // PartyPopup - Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); - for Pet := 0 to High(IPartyPopup) do - if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; - - - // Joypad - Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); - for Pet := 0 to High(IJoypad) do - if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - - // LCD - Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); - for Pet := 0 to High(ILPT) do - if Tekst = ILPT[Pet] then Ini.LPT := Pet; - - - // SongPath - if (Params.SongPath <> '') then - SongPath := IncludeTrailingPathDelimiter(Params.SongPath) - else - SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); - - Filename := IniFile.FileName; - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; - Tekst: string; - I: Integer; - S: String; -begin - //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin - if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin - - IniFile := TIniFile.Create(Filename); - - // Players - Tekst := IPlayers[Ini.Players]; - IniFile.WriteString('Game', 'Players', Tekst); - - // Difficulty - Tekst := IDifficulty[Ini.Difficulty]; - IniFile.WriteString('Game', 'Difficulty', Tekst); - - // Language - Tekst := ILanguage[Ini.Language]; - IniFile.WriteString('Game', 'Language', Tekst); - - // Tabs - Tekst := ITabs[Ini.Tabs]; - IniFile.WriteString('Game', 'Tabs', Tekst); - - // Sorting - Tekst := ISorting[Ini.Sorting]; - IniFile.WriteString('Game', 'Sorting', Tekst); - - // Debug - Tekst := IDebug[Ini.Debug]; - IniFile.WriteString('Game', 'Debug', Tekst); - - // Screens - Tekst := IScreens[Ini.Screens]; - IniFile.WriteString('Graphics', 'Screens', Tekst); - - // FullScreen - Tekst := IFullScreen[Ini.FullScreen]; - IniFile.WriteString('Graphics', 'FullScreen', Tekst); - - // Resolution - Tekst := IResolution[Ini.Resolution]; - IniFile.WriteString('Graphics', 'Resolution', Tekst); - - // Depth - Tekst := IDepth[Ini.Depth]; - IniFile.WriteString('Graphics', 'Depth', Tekst); - - // Resolution - Tekst := ITextureSize[Ini.TextureSize]; - IniFile.WriteString('Graphics', 'TextureSize', Tekst); - - // Sing Window - Tekst := ISingWindow[Ini.SingWindow]; - IniFile.WriteString('Graphics', 'SingWindow', Tekst); - - // Oscilloscope - Tekst := IOscilloscope[Ini.Oscilloscope]; - IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - - // Spectrum - Tekst := ISpectrum[Ini.Spectrum]; - IniFile.WriteString('Graphics', 'Spectrum', Tekst); - - // Spectrograph - Tekst := ISpectrograph[Ini.Spectrograph]; - IniFile.WriteString('Graphics', 'Spectrograph', Tekst); - - // Movie Size - Tekst := IMovieSize[Ini.MovieSize]; - IniFile.WriteString('Graphics', 'MovieSize', Tekst); - - // MicBoost - Tekst := IMicBoost[Ini.MicBoost]; - IniFile.WriteString('Sound', 'MicBoost', Tekst); - - // ClickAssist - Tekst := IClickAssist[Ini.ClickAssist]; - IniFile.WriteString('Sound', 'ClickAssist', Tekst); - - // BeatClick - Tekst := IBeatClick[Ini.BeatClick]; - IniFile.WriteString('Sound', 'BeatClick', Tekst); - - // Threshold - Tekst := IThreshold[Ini.Threshold]; - IniFile.WriteString('Sound', 'Threshold', Tekst); - - // Song Preview - Tekst := IPreviewVolume[Ini.PreviewVolume]; - IniFile.WriteString('Sound', 'PreviewVolume', Tekst); - - Tekst := IPreviewFading[Ini.PreviewFading]; - IniFile.WriteString('Sound', 'PreviewFading', Tekst); - - // SavePlayback - Tekst := ISavePlayback[Ini.SavePlayback]; - IniFile.WriteString('Sound', 'SavePlayback', Tekst); - - // Lyrics Font - Tekst := ILyricsFont[Ini.LyricsFont]; - IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); - - // Lyrics Effect - Tekst := ILyricsEffect[Ini.LyricsEffect]; - IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); - - // Solmization - Tekst := ISolmization[Ini.Solmization]; - IniFile.WriteString('Lyrics', 'Solmization', Tekst); - - // Theme - Tekst := ITheme[Ini.Theme]; - IniFile.WriteString('Themes', 'Theme', Tekst); - - // Skin - Tekst := ISkin[Ini.SkinNo]; - IniFile.WriteString('Themes', 'Skin', Tekst); - - // Color - Tekst := IColor[Ini.Color]; - IniFile.WriteString('Themes', 'Color', Tekst); - - // Record - for I := 0 to High(CardList) do begin - S := IntToStr(I+1); - - Tekst := CardList[I].Name; - IniFile.WriteString('Record', 'DeviceName' + S, Tekst); - - Tekst := IntToStr(CardList[I].Input); - IniFile.WriteString('Record', 'Input' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelL); - IniFile.WriteString('Record', 'ChannelL' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelR); - IniFile.WriteString('Record', 'ChannelR' + S, Tekst); - end; - - //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); - - //Advanced Settings - - //LoadAnimation - Tekst := ILoadAnimation[Ini.LoadAnimation]; - IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - - //EffectSing - Tekst := IEffectSing[Ini.EffectSing]; - IniFile.WriteString('Advanced', 'EffectSing', Tekst); - - //ScreenFade - Tekst := IScreenFade[Ini.ScreenFade]; - IniFile.WriteString('Advanced', 'ScreenFade', Tekst); - - //AskbeforeDel - Tekst := IAskbeforeDel[Ini.AskbeforeDel]; - IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); - - //OnSongClick - Tekst := IOnSongClick[Ini.OnSongClick]; - IniFile.WriteString('Advanced', 'OnSongClick', Tekst); - - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Advanced', 'LineBonus', Tekst); - - //Party Popup - Tekst := IPartyPopup[Ini.PartyPopup]; - IniFile.WriteString('Advanced', 'PartyPopup', Tekst); - - // Joypad - Tekst := IJoypad[Ini.Joypad]; - IniFile.WriteString('Controller', 'Joypad', Tekst); - - IniFile.Free; - end; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - //Name - // Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); - - IniFile.Free; - end; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); - - IniFile.Free; - end; -end; - -end. +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses IniFiles, ULog, SysUtils; + +type + TIni = class + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + Threshold: integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + + // Record + Card: integer; // not saved in config.ini + + CardList: array of record + Name: string; + Input: integer; + ChannelL: integer; + ChannelR: integer; + end; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskbeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + // Soundcards + SoundCard: array[0..7, 1..2] of integer; + + // Devices + LPT: integer; + + procedure Load; + procedure Save; + procedure SaveNames; + procedure SaveLevel; + end; + + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + ICard: array of string; + IInput: array of string; + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); + //IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array [0..1] of String =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); + + IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + +implementation + +uses //UFiles, + UMain, + SDL, + ULanguage, + USkins, + URecord, + UCommandLine; + +procedure TIni.Load; +var + IniFile: TMemIniFile; + ThemeIni: TMemIniFile; + Tekst: string; + Pet: integer; + B: boolean; + I, I2, I3: integer; + S: string; + Modes: PPSDL_Rect; + SR: TSearchRec; //Skin List Patch + + function GetFileName (S: String):String; + begin + //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); + Result := copy (S,0,Pos ('.ini',S)-1); + end; + +begin + GamePath := ExtractFilePath(ParamStr(0)); + + if (Params.ConfigFile <> '') then + try + IniFile := TMemIniFile.Create(Params.ConfigFile); + except + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + end + else + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + + // Name + for I := 0 to 11 do + Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + + // Templates for Names Mod + for I := 0 to 2 do + Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); + for Pet := 0 to High(IPlayers) do + if Tekst = IPlayers[Pet] then Ini.Players := Pet; + + // Difficulty + Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); + for Pet := 0 to High(IDifficulty) do + if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; + + // Language + Tekst := IniFile.ReadString('Game', 'Language', 'English'); + for Pet := 0 to High(ILanguage) do + if Tekst = ILanguage[Pet] then Ini.Language := Pet; + +// Language.ChangeLanguage(ILanguage[Ini.Language]); + + // Tabs + Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); + for Pet := 0 to High(ITabs) do + if Tekst = ITabs[Pet] then Ini.Tabs := Pet; + + //Tabs at Startup fix + Ini.Tabs_at_startup := Ini.Tabs; + + // Sorting + Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); + for Pet := 0 to High(ISorting) do + if Tekst = ISorting[Pet] then Ini.Sorting := Pet; + + // Debug + Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); + for Pet := 0 to High(IDebug) do + if Tekst = IDebug[Pet] then Ini.Debug := Pet; + + //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; + + // Screens + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + for Pet := 0 to High(IScreens) do + if Tekst = IScreens[Pet] then Ini.Screens := Pet; + + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + + // Resolution + SetLength(IResolution, 0); + + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + end; + + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + Ini.FullScreen := 0; + end; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do begin + S := IResolution[I]; + IResolution[I] := IResolution[High(IResolution)-I]; + IResolution[High(IResolution)-I] := S; + end; + + Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + for Pet := 0 to High(IResolution) do + if Tekst = IResolution[Pet] then Ini.Resolution := Pet; + + + // Resolution + Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); + for Pet := 0 to High(IDepth) do + if Tekst = IDepth[Pet] then Ini.Depth := Pet; + + // Texture Size + Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); + for Pet := 0 to High(ITextureSize) do + if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; + + // SingWindow + Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); + for Pet := 0 to High(ISingWindow) do + if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; + + // Oscilloscope + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); + for Pet := 0 to High(IOscilloscope) do + if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; + + // Spectrum + Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); + for Pet := 0 to High(ISpectrum) do + if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; + + // Spectrograph + Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); + for Pet := 0 to High(ISpectrograph) do + if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; + + // MovieSize + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); + for Pet := 0 to High(IMovieSize) do + if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; + + // MicBoost + Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); + for Pet := 0 to High(IMicBoost) do + if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; + + // ClickAssist + Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); + for Pet := 0 to High(IClickAssist) do + if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; + + // BeatClick + Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); + for Pet := 0 to High(IBeatClick) do + if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; + + // SavePlayback + Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); + for Pet := 0 to High(ISavePlayback) do + if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; + + // Threshold + Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); + for Pet := 0 to High(IThreshold) do + if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + + //Song Preview + Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); + for Pet := 0 to High(IPreviewVolume) do + if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; + + Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); + for Pet := 0 to High(IPreviewFading) do + if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; + + // Lyrics Font + Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); + for Pet := 0 to High(ILyricsFont) do + if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; + + // Lyrics Effect + Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); + for Pet := 0 to High(ILyricsEffect) do + if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; + + // Solmization + Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); + for Pet := 0 to High(ISolmization) do + if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; + + // Theme + + //Theme List Patch + + //I2 Saves the no of the Deluxe (Standard-) Theme + I2 := 0; + //I counts is the cur. Theme no + I := 0; + + SetLength(ITheme, 0); + FindFirst('Themes' + PathDelim + '*.ini',faAnyFile,SR); + Repeat + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SR.Name); + Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); + ThemeIni.Free; + + //if Deluxe Theme then save Themeno to I2 + if (Tekst = 'DELUXE') then + I2 := I; + + //Search for Skins for this Theme + for Pet := low(Skin.Skin) to high(Skin.Skin) do + begin + if UpperCase(Skin.Skin[Pet].Theme) = Tekst then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := GetFileName(SR.Name); + break; + end; + end; + + Inc(I); + Until FindNext(SR) <> 0; + FindClose(SR); + //Theme List Patch End } + + //No Theme Found + if (Length(ITheme)=0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); + Ini.Theme := 0; + for Pet := 0 to High(ITheme) do + if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; + + // Skin + Skin.onThemeChange; + Ini.SkinNo := 0; + + Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); + for Pet := 0 to High(ISkin) do + if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; + + // Color + Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); + for Pet := 0 to High(IColor) do + if Tekst = IColor[Pet] then Ini.Color := Pet; + + // Record - load ini list + SetLength(CardList, 0); + I := 1; + while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin + //Automatically Delete not Existing Sound Cards + S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); + //{ + B := False; + //Look for Soundcard + for I2 := 0 to High(Recording.SoundCard) do + begin + if (S = Trim(Recording.SoundCard[I2].Description)) then + begin + B := True; + Break; + end; + end; + + if B then + begin //} + I3 := Length(CardList); + SetLength(CardList, I3+1); + Ini.CardList[I3].Name := S; + Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); + Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); + Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); + end; + Inc(I); + end; + + // Record - append detected soundcards + for I := 0 to High(Recording.SoundCard) do + begin + B := False; + For I2 := 0 to High(CardList) do + begin //Search for Card in List + if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then + begin + B := True; + Break; + end; + end; + + //If not in List -> Add + If not B then + begin + I3 := Length(CardList); + SetLength(CardList, I3+1); + CardList[I3].Name := Trim(Recording.SoundCard[I].Description); + CardList[I3].Input := 0; + CardList[I3].ChannelL := 0; + CardList[I3].ChannelR := 0; + // default for new users + if (Length(CardList) = 1) then + CardList[I].ChannelL := 1; + end; + end; + + //Advanced Settings + + // LoadAnimation + Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); + for Pet := 0 to High(ILoadAnimation) do + if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; + + // ScreenFade + Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); + for Pet := 0 to High(IScreenFade) do + if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; + + // EffectSing + Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); + for Pet := 0 to High(IEffectSing) do + if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; + + // AskbeforeDel + Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); + for Pet := 0 to High(IAskbeforeDel) do + if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; + + // OnSongClick + Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); + for Pet := 0 to High(IOnSongClick) do + if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; + + // Linebonus + Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + + // PartyPopup + Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); + for Pet := 0 to High(IPartyPopup) do + if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; + + + // Joypad + Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); + for Pet := 0 to High(IJoypad) do + if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; + + // LCD + Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); + for Pet := 0 to High(ILPT) do + if Tekst = ILPT[Pet] then Ini.LPT := Pet; + + + // SongPath + if (Params.SongPath <> '') then + SongPath := IncludeTrailingPathDelimiter(Params.SongPath) + else + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + + Filename := IniFile.FileName; + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; + Tekst: string; + I: Integer; + S: String; +begin + //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin + + IniFile := TIniFile.Create(Filename); + + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); + + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); + + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); + + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); + + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); + + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); + + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); + + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); + + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); + + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); + + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); + + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); + + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); + + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); + + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); + + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); + + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); + + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); + + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); + + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); + + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); + + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); + + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); + + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); + + // Record + for I := 0 to High(CardList) do begin + S := IntToStr(I+1); + + Tekst := CardList[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + + Tekst := IntToStr(CardList[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelL); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelR); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; + + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + + //Advanced Settings + + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); + + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); + + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); + + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); + + IniFile.Free; + end; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + //Name + // Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); + + IniFile.Free; + end; +end; + +end. \ No newline at end of file -- cgit v1.2.3 From 3d2e9f4f029c5bb8868bb438d677c724ff6a2609 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 22 Nov 2007 21:05:11 +0000 Subject: Added LogBuffer to dump binary data to a file. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@628 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 7f0b82c4..ac08f2d5 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -45,6 +45,7 @@ type // compability procedure LogStatus(Log1, Log2: string); procedure LogError(Log1, Log2: string); overload; + procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string); end; var @@ -256,6 +257,24 @@ begin Halt; end; +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string); +var + f : TFileStream; +begin + f := nil; + + try + f := TFileStream.Create( filename, fmCreate); + f.Write( buf^, bufLength); + f.Free; + except + on e : Exception do begin + Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); + f.Free; + end; + end; +end; + end. -- cgit v1.2.3 From d8c84c39ed5d060e0c172e6fa478936a6337c147 Mon Sep 17 00:00:00 2001 From: mogguh Date: Fri, 23 Nov 2007 18:48:31 +0000 Subject: Fonts are readable again, didn't edit the outline fonts (will be done later, maybe) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@641 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 7475da7a..ed897071 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -140,7 +140,7 @@ begin Log.LogStatus( 'Font' , '---------------------------'); SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Font', 0); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Transparent', 0); Fonts[0].Tex.H := 30; Fonts[0].AspectW := 0.9; Fonts[0].Done := -1; @@ -148,21 +148,21 @@ begin Log.LogStatus( 'FontB' , '---------------------------'); - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Font', 0); + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', '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', 'PNG', 'Font Outline', 0); + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', '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', 'PNG', 'Font Outline 2', 0); + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Transparent', 0); Fonts[3].Tex.H := 30; Fonts[3].AspectW := 0.95; Fonts[3].Done := -1; @@ -262,7 +262,7 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, TexNum); glBegin(GL_QUADS); @@ -321,7 +321,7 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, TexNum); glBegin(GL_QUADS); glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); -- cgit v1.2.3 From 80f3f5fe438a48b94a2ec9c70e6ff8475ede4ff3 Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 23 Nov 2007 21:32:44 +0000 Subject: checking for delta=0 in col2h git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@652 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 7b537840..445c7d4f 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -427,6 +427,8 @@ procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); clr[2]:=(Color and $ff)/255; hls[1]:=maxvalue(clr); delta:=hls[1]-minvalue(clr); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; -- cgit v1.2.3 From 64de8825666fcb234fb31b4c716cf1c9fbcaacfe Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 28 Nov 2007 16:35:34 +0000 Subject: fixed lazarus build-error due to differing declarations of FindFirstFileW and FindNextFileW (var vs pointer) in delphi and lazarus git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@655 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformWindows.pas | 54 +++++++++++++++++++++------------- 1 file changed, 33 insertions(+), 21 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index afdcebcf..93e72e7a 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -11,7 +11,7 @@ interface uses Classes, UPlatform; type - + TPlatformWindows = class(TPlatform) public Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; @@ -23,7 +23,7 @@ implementation uses SysUtils, Windows; type - + TSearchRecW = record Time: Integer; Size: Integer; @@ -45,7 +45,11 @@ 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); @@ -56,7 +60,11 @@ 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; @@ -78,7 +86,11 @@ 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; @@ -101,31 +113,31 @@ begin end; //------------------------------ -//Start more than One Time Prevention -//------------------------------ +//Start more than One Time Prevention +//------------------------------ function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; var hWnd: THandle; - I: Integer; + 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; + //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; -- cgit v1.2.3 From e4c285f12b6571773b6ff6b5c03b9f948116c7e7 Mon Sep 17 00:00:00 2001 From: b1indy Date: Mon, 3 Dec 2007 12:08:25 +0000 Subject: Initialize SDL_GL_ALPHA_SIZE for the OpenGL Surface git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@659 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 02c06002..c3b042ea 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -521,6 +521,7 @@ begin SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); -- cgit v1.2.3 From 1faf3afc9b8c30c47a3f3d6a92ff0b4b18cddefd Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 20:35:57 +0000 Subject: New portaudio interface added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@663 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_portaudio.pas | 434 +++++++++++++++++++++++++++++++++ 1 file changed, 434 insertions(+) create mode 100644 Game/Code/Classes/UAudio_portaudio.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_portaudio.pas b/Game/Code/Classes/UAudio_portaudio.pas new file mode 100644 index 00000000..9ed2107d --- /dev/null +++ b/Game/Code/Classes/UAudio_portaudio.pas @@ -0,0 +1,434 @@ +unit UAudio_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + portaudio, + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; +{ +type + TPaHostApiIndex = PaHostApiIndex; + TPaDeviceIndex = PaDeviceIndex; + PPaStream = ^PaStreamPtr; + PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; + TPaStreamCallbackFlags = PaStreamCallbackFlags; + TPaHostApiTypeId = PaHostApiTypeId; + PPaHostApiInfo = ^PaHostApiInfo; + PPaDeviceInfo = ^PaDeviceInfo; + TPaError = PaError; + TPaStreamParameters = PaStreamParameters; +} +type + TAudio_Portaudio = class( TInterfacedObject, IAudioInput ) + private + function GetPreferredApiIndex(): TPaHostApiIndex; + public + function GetName: String; + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + end; + + TPortaudioSoundCard = class(TGenericSoundCard) + RecordStream: PPaStream; + DeviceIndex: TPaDeviceIndex; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +var + singleton_MusicPortaudio : IAudioInput; + +const + sampleRate: Double = 44100.; + +{* the default API used by Portaudio is the least common denominator + * and might lack efficiency. ApiPreferenceOrder defines the order of + * preferred APIs to use. The first API-type in the list is tried first. If it's + * not available the next is tried, ... + * If none of the preferred APIs was found the default API is used. + * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi + * as an array's only member if you do not have any preferences. + * paDefaultApi also terminates a preferences list but this is optional. + *} +const + paDefaultApi = -1; +var + ApiPreferenceOrder: +{$IF Defined(WIN32)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME + //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note1: Portmixer has no mixer support for paJACK at the moment + // Note2: Not tested, but ALSA might be better than OSS. + array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); +{$ELSEIF Defined(DARWIN)} + // Note: Not tested. + //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + +function TAudio_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudio_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; +begin + result := -1; + + // select preferred sound-API + for i:= 0 to High(ApiPreferenceOrder) do + begin + if(ApiPreferenceOrder[i] <> paDefaultApi) then begin + // check if API is available + result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(result >= 0) then + break; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then begin + result := Pa_GetDefaultHostApi(); + end; +end; + +// TODO: should be a function with boolean return type +procedure TAudio_Portaudio.InitializeRecord; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + inputCnt: integer; + inputName: string; + SC: integer; // soundcard + SCI: integer; // soundcard input + err: TPaError; + errMsg: string; + paSoundCard: TPortaudioSoundCard; + inputParams: TPaStreamParameters; + stream: PPaStream; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + {$ENDIF} +begin + // TODO: call Pa_Terminate() on termination + err := Pa_Initialize(); + if(err <> paNoError) then begin + Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + // result := false; + Exit; + end; + + apiIndex := GetPreferredApiIndex(); + apiInfo := Pa_GetHostApiInfo(apiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL + for i:= 0 to High(Recording.SoundCard) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + // current device is no input device -> skip + if(deviceInfo^.maxInputChannels <= 0) then + continue; + + // TODO: free object on termination + paSoundCard := TPortaudioSoundCard.Create(); + Recording.SoundCard[SC] := paSoundCard; + + // retrieve device-name + deviceName := deviceInfo^.name; + paSoundCard.Description := deviceName; + paSoundCard.DeviceIndex := deviceIndex; + + // setup desired input parameters + with inputParams do begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // check if device supports our input-format + err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); + if(err <> 0) then begin + // format not supported -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + // TODO: retry with mono if stereo is not supported + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + + err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); + if(err <> paNoError) then begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + + {$IFDEF UsePortmixer} + + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + inputCnt := Px_GetNumInputSources(mixer); + SetLength(paSoundCard.Input, inputCnt); + + // get input names + for SCI := 0 to inputCnt-1 do + begin + inputName := Px_GetInputSourceName(mixer, SCI); + paSoundCard.Input[SCI].Name := inputName; + end; + + Px_CloseMixer(mixer); + + {$ELSE} // !UsePortmixer + + //Pa_StartStream(stream); + // TODO: check if callback was called (this problem may occur on some devices) + //Pa_StopStream(stream); + + Pa_CloseStream(stream); + + // create a standard input source + SetLength(paSoundCard.Input, 1); + paSoundCard.Input[0].Name := 'Standard'; + + {$ENDIF} + + // use default input source + paSoundCard.InputSelected := 0; + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(Recording.SoundCard, SC); + + Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); + + { + SoundCard[SC].InputSelected := Mic[Device]; + } +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_Portaudio.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_Portaudio.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Portaudio input capture callback. + *} +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); + result := paContinue; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudio_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: TPaError; + ErrorMsg: string; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + Log.LogStatus('Cap1', 'Portaudio'); + + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + paSoundCard.CaptureSoundLeft := CaptureSoundLeft; + paSoundCard.CaptureSoundRight := CaptureSoundRight; + + // get input latency info + deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); + + // set input stream parameters + with inputParams do begin + device := paSoundCard.DeviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); + Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(paSoundCard)); + if(Error <> paNoError) then begin + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); + //Halt; + end; + + paSoundCard.RecordStream := stream; + + // start capture + Error := Pa_StartStream(stream); + if(Error <> paNoError) then begin + Pa_CloseStream(stream); + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); + //Halt; + end; + + //Readln; + Log.LogStatus('Cap2', 'Portaudio'); +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudio_Portaudio.StopCard(Card: byte); +var + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + stream := paSoundCard.RecordStream; + if(stream <> nil) then begin + Pa_StopStream(stream); + Pa_CloseStream(stream); + end; +end; + + +initialization + singleton_MusicPortaudio := TAudio_Portaudio.create(); + writeln( 'UAudio_Portaudio - Register' ); + AudioManager.add( singleton_MusicPortaudio ); + +finalization + writeln( 'UAudio_Portaudio - UnRegister' ); + AudioManager.Remove( singleton_MusicPortaudio ); + +end. -- cgit v1.2.3 From d5ecf3a8ca7d6caf21721018bb74c1fa47a83711 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 20:51:57 +0000 Subject: - Sound-Device initialization was moved from URecord to the specific Audio-Interface (Bass/Portaudio) called by InitializeSound(). As TIni.Create needs a filled in Recording.SoundCard array, InitialzeSound() has to be called before TIni.Create. - Sound is now Recording.Sound git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@664 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 924ef0ab..67ec2ea8 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -191,6 +191,13 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Soundcard list', 1); + // Sound (+ fills Sound Card List) + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + // Ini + Paths Log.BenchmarkStart(1); Log.LogStatus('Load Ini', 'Initialization'); @@ -262,7 +269,7 @@ begin Log.LogStatus('Creating 2nd Song Array', 'Initialization'); CatSongs := TCatSongs.Create; - + Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Songs', 1); @@ -281,15 +288,6 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PartySession Manager', 1); } - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - InitializeSound(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 1); - - // exit; - // Graphics Log.BenchmarkStart(1); Log.LogStatus('Initialize 3D', 'Initialization'); @@ -813,7 +811,7 @@ begin // beep; // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas - if not assigned( Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. + if not assigned( Recording.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. exit; // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) @@ -822,7 +820,7 @@ begin begin // analyze buffer - Sound[CP].AnalizujBufor; + Recording.Sound[CP].AnalizujBufor; // adds some noise // Czas.Ton := Czas.Ton + Round(Random(3)) - 1; @@ -857,7 +855,7 @@ begin // Czas.Ton := 27; // gdy moze, to dodaje nute - if (Sound[CP].SzczytJest) and (Mozna) then begin + if (Recording.Sound[CP].SzczytJest) and (Mozna) then begin // operowanie na ostatniej nucie for Pet := 0 to Czesci[0].Czesc[S].HighNut do if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) @@ -866,10 +864,10 @@ begin // to robi, tylko dla pary nut (oryginalnej i gracza) // przesuwanie tonu w odpowiednia game - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - Sound[CP].Ton := Sound[CP].Ton - 12; - while (Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - Sound[CP].Ton := Sound[CP].Ton + 12; + while (Recording.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + Recording.Sound[CP].Ton := Recording.Sound[CP].Ton - 12; + while (Recording.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + Recording.Sound[CP].Ton := Recording.Sound[CP].Ton + 12; // Half size Notes Patch NoteHit := false; @@ -878,8 +876,8 @@ begin //if Ini.Difficulty = 1 then Range := 1; //if Ini.Difficulty = 2 then Range := 0; Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Sound[CP].Ton) <= Range then begin - Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Recording.Sound[CP].Ton) <= Range then begin + Recording.Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; // Half size Notes Patch @@ -919,7 +917,8 @@ begin if S = SMax then begin Nowa := true; // jezeli ostatnia ma ten sam ton - if (Player[CP].IlNut > 0 ) and (Player[CP].Nuta[Player[CP].HighNut].Ton = Sound[CP].Ton) + if (Player[CP].IlNut > 0 ) + and (Player[CP].Nuta[Player[CP].HighNut].Ton = Recording.Sound[CP].Ton) and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) then Nowa := false; // jezeli jest jakas nowa nuta na sprawdzanym beacie @@ -935,7 +934,7 @@ begin SetLength(Player[CP].Nuta, Player[CP].IlNut); Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Ton := Recording.Sound[CP].Ton; // Ton || TonDokl Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; -- cgit v1.2.3 From a4a3643898a9f566b926bbd5fcc47c24a18be1ab Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:11:16 +0000 Subject: Sound is now Recording.Sound git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@665 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UDraw.pas | 8 ++++---- Game/Code/Classes/ULog.pas | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index efc3494b..c399057b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -169,10 +169,10 @@ begin; glColor3f(1, 1, 1); } glBegin(GL_LINE_STRIP); - glVertex2f(X, -Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); - for Pet := 2 to Sound[NrSound].n div 1 do begin - glVertex2f(X + (Pet-1) * W / (Sound[NrSound].n - 1), - -Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + glVertex2f(X, -Recording.Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + for Pet := 2 to Recording.Sound[NrSound].n div 1 do begin + glVertex2f(X + (Pet-1) * W / (Recording.Sound[NrSound].n - 1), + -Recording.Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); end; glEnd; end; diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index ac08f2d5..50e9bf68 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -214,9 +214,9 @@ begin FS := TFileStream.Create(FileName, fmCreate); - for BL := 0 to High(Sound[SoundNr].BufferLong) do begin - Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); - FS.CopyFrom(Sound[SoundNr].BufferLong[BL], Sound[SoundNr].BufferLong[BL].Size); + for BL := 0 to High(Recording.Sound[SoundNr].BufferLong) do begin + Recording.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); + FS.CopyFrom(Recording.Sound[SoundNr].BufferLong[BL], Recording.Sound[SoundNr].BufferLong[BL].Size); end; FS.Free; -- cgit v1.2.3 From 9ced8826685af3aece39649fb0912780781ab2ae Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:19:50 +0000 Subject: - Removed all BASS stuff. BASS initialization is now done in UAudio_bass (or UAudio_portaudio). - Sound moved to Recording.Sound - Removed duplicated unreferenced global Soundcard-array var (which was moved to the TRecord-Class previously but has not been deleted) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@666 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/URecord.pas | 186 ++++++++++++------------------------------ 1 file changed, 52 insertions(+), 134 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 29a9d7f9..dee1a687 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -11,9 +11,6 @@ interface uses Classes, Math, SysUtils, - {$IFDEF useBASS} - bass, - {$ENDIF} UCommon, UMusic, UIni; @@ -46,32 +43,31 @@ type Name: string; end; - TSoundCard = record + TGenericSoundCard = class // here can be the soundcard information - whole database from which user will select recording source - Description: string; - Input: array of TSoundCardInput; - InputSelected: integer; - MicInput: Integer; - - // bass record - BassRecordStream: hStream; + Description: string; // soundcard name/description + Input: array of TSoundCardInput; // soundcard input(-source)s + InputSelected: integer; // unused. What is this good for? + MicInput: integer; // unused. What is this good for? + //SampleRate: integer; // TODO: for sample-rate conversion (for devices that do not support 44.1kHz) + CaptureSoundLeft: TSound; // sound(-buffer) used for left channel capture data + CaptureSoundRight: TSound; // sound(-buffer) used for right channel capture data end; TRecord = class - SoundCard: array of TSoundCard; + Sound: array of TSound; + SoundCard: array of TGenericSoundCard; constructor Create; + + // handle microphone input + procedure HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; + InputDevice: TGenericSoundCard); end; smallintarray = array [0..maxInt shr 1-1] of smallInt; psmallintarray = ^smallintarray; - // procedures - bass record - function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; - - var - Sound: array of TSound; - SoundCard: array of TSoundCard; Poz: integer; Recording: TRecord; @@ -79,6 +75,10 @@ implementation uses UMain; +// FIXME: Race-Conditions between Callback-thread and main-thread +// on BufferArray (maybe BufferNew also). +// Use SDL-mutexes to solve this problem. + procedure TSound.ProcessNewBuffer; var S: integer; @@ -197,7 +197,17 @@ begin Result := 1 - Count / Il; end; -function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall; +{* + * Handle captured microphone input data. + * Params: + * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. + * Interleaved means that a right-channel sample follows a left- + * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). + * Length - number of bytes in Buffer + * Input - Soundcard-Input used for capture + *} +procedure TRecord.HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; + InputDevice: TGenericSoundCard); var L: integer; S: integer; @@ -205,8 +215,6 @@ var PSI: psmallintarray; I: integer; Skip: integer; - P1: integer; - P2: integer; Boost: byte; begin // set boost @@ -218,7 +226,7 @@ begin end; // boost buffer - L := Len div 2; // number of samples + L := Length div 2; // number of samples PSI := Buffer; for S := 0 to L-1 do begin @@ -228,139 +236,49 @@ begin PSI^[S] := I; end; - // decode user - P1 := (user and 255) - 1; - P2 := (user div 256) - 1; - - // 2 players USB mic, left channel - if P1 >= 0 then + if InputDevice.CaptureSoundLeft <> nil then begin - L := Len div 4; // number of samples + L := Length div 4; // number of samples PB := Buffer; - Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting - for S := 1 to L do + InputDevice.CaptureSoundLeft.BufferNew.Clear; // 0.5.2: problem on exiting + for S := 0 to L-1 do begin - Sound[P1].BufferNew.Write(PB[(S-1)*4], 2); + InputDevice.CaptureSoundLeft.BufferNew.Write(PB[S*4], 2); end; - Sound[P1].ProcessNewBuffer; + InputDevice.CaptureSoundLeft.ProcessNewBuffer; end; // 2 players USB mic, right channel Skip := 2; - if P2 >= 0 then + if InputDevice.CaptureSoundRight <> nil then begin - L := Len div 4; // number of samples + L := Length div 4; // number of samples PB := Buffer; - Sound[P2].BufferNew.Clear; - for S := 1 to L do + InputDevice.CaptureSoundRight.BufferNew.Clear; + for S := 0 to L-1 do begin - Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2); + InputDevice.CaptureSoundRight.BufferNew.Write(PB[Skip + S*4], 2); end; - Sound[P2].ProcessNewBuffer; + InputDevice.CaptureSoundRight.ProcessNewBuffer; end; - - Result := true; end; constructor TRecord.Create; var - SC: integer; // soundcard - SCI: integer; // soundcard input - Descr: string; - InputName: PChar; - Flags: integer; - No: integer; - - function isDuplicate(Desc: String): Boolean; - var - I: Integer; - begin - Result := False; - //Check for Soundcard with same Description - For I := 0 to SC-1 do - begin - if (SoundCard[I].Description = Desc) then - begin - Result := True; - Break; - end; - end; - end; - + S: integer; begin - // TODO : JB_linux - Reimplement recording, without bass for linux - {$IFDEF useBASS} - // checks for recording devices and puts them into array; - SetLength(SoundCard, 0); - - SC := 0; - Descr := BASS_RecordGetDeviceDescription(SC); - - while (Descr <> '') do - begin - - //If there is another SoundCard with the Same ID, Search an available Name - if (IsDuplicate(Descr)) then - begin - No:= 1; //Count of SoundCards with same Name - Repeat - Inc(No) - Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - - //Set Description - Descr := Descr + ' (' + InttoStr(No) + ')'; - end; - - SetLength(SoundCard, SC+1); - - SoundCard[SC].Description := Descr; - - //Get Recording Inputs - SCI := 0; - BASS_RecordInit(SC); - - InputName := BASS_RecordGetInputName(SCI); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty - // InputName. So, we have to add a hard coded - // Workaround for this problem - if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then - begin - InputName := 'Microphone'; - end; - {$ENDIF} - - SetLength(SoundCard[SC].Input, 1); - SoundCard[SC].Input[SCI].Name := InputName; - - // process each input - while (InputName <> nil) do - begin - Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then - begin - SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; - end; - - //Set Mic Index - if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then - SoundCard[SC].MicInput := SCI; - - Inc(SCI); - InputName := BASS_RecordGetInputName(SCI); - end; - - BASS_RecordFree; - - Inc(SC); - Descr := BASS_RecordGetDeviceDescription(SC); - end; // while - {$ENDIF} + SetLength(Sound, 6 {max players});//Ini.Players+1); + for S := 0 to High(Sound) do begin //Ini.Players do begin + Sound[S] := TSound.Create; + Sound[S].Num := S; + Sound[S].BufferNew := TMemoryStream.Create; + SetLength(Sound[S].BufferLong, 1); + Sound[S].BufferLong[0] := TMemoryStream.Create; + Sound[S].n := 4*1024; + end; end; -- cgit v1.2.3 From 7e4373d4c9d5718f8beb97a28763a68580ad8ea9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:35:23 +0000 Subject: Removed duplicated registration to the AudioManager. Registering once is enough (Casting has no effect here) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@667 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMedia_dummy.pas | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 0c788677..42a3f1b9 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -261,19 +261,11 @@ end; initialization singleton_dummy := Tmedia_dummy.create(); - writeln( 'UMedia_dummy - Register dummy Video_Playback' ); - AudioManager.add( IVideoPlayback( singleton_dummy ) ); + writeln( 'UMedia_dummy - Register' ); + AudioManager.add( singleton_dummy ); - writeln( 'UMedia_dummy - Register dummy Video_Playback' ); - AudioManager.add( IAudioPlayback( singleton_dummy ) ); - - writeln( 'UMedia_dummy - Register dummy Video_Playback' ); - AudioManager.add( IAudioInput( singleton_dummy ) ); - finalization - AudioManager.Remove( IVideoPlayback( singleton_dummy ) ); - AudioManager.Remove( IAudioPlayback( singleton_dummy ) ); - AudioManager.Remove( IAudioInput( singleton_dummy ) ); - + writeln( 'UMedia_dummy - UnRegister' ); + AudioManager.Remove( singleton_dummy ); end. -- cgit v1.2.3 From 80c11b3e86ee826e66640711f11f927472f6ce47 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:41:56 +0000 Subject: - Moved GetFFTData from IAudioInput -> IAudioOutput (it is used for the song-selection equalizer not for mic-input) - CaptureCard/StopCard is not visible to public anymore git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@668 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 3fc1136b..feba3f61 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -162,6 +162,9 @@ type //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); + + //Equalizer + function GetFFTData: TFFTData; end; IAudioInput = Interface @@ -171,12 +174,6 @@ type procedure CaptureStart; procedure CaptureStop; - - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - - //Equalizer - function GetFFTData: TFFTData; end; -- cgit v1.2.3 From 21e5e8cec6f253ec24b5116b4020dc62bb2a80b1 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:48:59 +0000 Subject: - Moved initialization from URecord to UAudio_bass. - Removed duplicate registration at AudioManager - separated input an output functions so input-functionality can be switched on and off with the UseBASSInput define - Removed HWND Windows stuff git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@669 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_bass.pas | 1297 ++++++++++++++++++------------------- 1 file changed, 648 insertions(+), 649 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 9ef3b789..bcf01f92 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -1,649 +1,648 @@ -unit UAudio_bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - - bass, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; - -const - RecordSystem = 1; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -type - TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput ) - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - fHWND: THandle; - - public - Bass: hStream; - function GetName: String; - procedure InitializePlayback; - procedure InitializeRecord; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); -end; - -var - singleton_MusicBass : IAudioPlayback; - -function TAudio_bass.GetName: String; -begin - result := 'BASS'; -end; - -procedure TAudio_bass.InitializePlayback; -var - Pet: integer; - S: integer; -begin - writeln( 'TAudio_bass.InitializePlayback' ); -// Log.BenchmarkStart(4); -// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - - writeln( 'TAudio_bass AllocateHWND' ); - {$ifdef win32} - // TODO : JB_Linux ... is this needed ? :) - fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function - {$ENDIF} - - - writeln( 'TAudio_bass BASS_Init' ); - // TODO : jb_linux replace with something other than bass - if not BASS_Init(1, 44100, 0, fHWND, nil) then - begin - {$IFNDEF FPC} - // TODO : JB_linux find a way to do this nice.. - Application.MessageBox ('Could not initialize BASS', 'Error'); - {$ENDIF} - Exit; - end; - -// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - -// Log.LogStatus('Loading Sounds', 'Music Initialize'); - - writeln( 'TAudio_bass LoadSoundFromFile' ); -// Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - -// Log.BenchmarkEnd(4); -// Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TAudio_bass.InitializeRecord; -var - S: integer; - device: integer; - descr: string; - input: integer; - input2: integer; - flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input -begin - if RecordSystem = 1 then begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; - - - // check for recording devices; - {device := 0; - descr := BASS_RecordGetDeviceDescription(device); - - SetLength(SoundCard, 0); - while (descr <> '') do begin - SC := High(SoundCard) + 1; - SetLength(SoundCard, SC+1); - - Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr); - SoundCard[SC].Description := Descr; - - // check for recording inputs - mic[device] := -1; // default to no change - input := 0; - BASS_RecordInit(device); - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - flags := BASS_RecordGetInput(input); - - SetLength(SoundCard[SC].Input, 0); - while (flags <> -1) do begin - SCI := High(SoundCard[SC].Input) + 1; - SetLength(SoundCard[SC].Input, SCI+1); - - Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input)); - SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input); - - if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin - mic[device] := input; // auto set microphone - end; - Inc(Input); - flags := BASS_RecordGetInput(input); - end; - - if mic[device] <> -1 then begin - Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device])) - end else begin - Log.LogAnalyze('Mic not found'); - mic[device] := 0; // setting to the first one (for kxproject) - end; - SoundCard[SC].InputSeleceted := Mic[Device]; - - - BASS_RecordFree; - - inc(Device); - descr := BASS_RecordGetDeviceDescription(Device); - end; // while} - end; // if -end; - -procedure TAudio_bass.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - - // TODO : jb_linux replace with something other than bass - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -end; - -procedure TAudio_bass.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TAudio_bass.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_bass.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - // TODO : jb_linux replace with something other than bass - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_bass.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TAudio_bass.MoveTo(Time: real); -var - bytes: integer; -begin - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TAudio_bass.Play; -begin - // TODO : jb_linux replace with something other than bass - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; -end; - -procedure TAudio_bass.Pause; //Pause Mod -begin - // TODO : jb_linux replace with something other than bass - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; -end; - -procedure TAudio_bass.Stop; -begin - // TODO : jb_linux replace with something other than bass - Bass_ChannelStop(Bass); -end; - -procedure TAudio_bass.Close; -begin - // TODO : jb_linux replace with something other than bass - Bass_StreamFree(Bass); -end; - -function TAudio_bass.Length: real; -var - bytes: integer; -begin - Result := 60; - - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); -end; - -function TAudio_bass.getPosition: real; -var - bytes: integer; -begin - Result := 0; - - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -end; - -function TAudio_bass.Finished: boolean; -begin - Result := false; - - // TODO : jb_linux replace with something other than bass - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -end; - -procedure TAudio_bass.PlayStart; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassStart, True); -end; - -procedure TAudio_bass.PlayBack; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassBack, True);// then -end; - -procedure TAudio_bass.PlaySwoosh; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassSwoosh, True); -end; - -procedure TAudio_bass.PlayChange; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassChange, True); -end; - -procedure TAudio_bass.PlayOption; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassOption, True); -end; - -procedure TAudio_bass.PlayClick; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClick, True); -end; - -procedure TAudio_bass.PlayDrum; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassDrum, True); -end; - -procedure TAudio_bass.PlayHihat; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassHihat, True); -end; - -procedure TAudio_bass.PlayClap; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassClap, True); -end; - -procedure TAudio_bass.PlayShuffle; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelPlay(BassShuffle, True); -end; - -procedure TAudio_bass.StopShuffle; -begin - // TODO : jb_linux replace with something other than bass - BASS_ChannelStop(BassShuffle); -end; - -procedure TAudio_bass.CaptureStart; -var - S: integer; - SC: integer; - P1: integer; - P2: integer; -begin - for S := 0 to High(Sound) do - Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then - CaptureCard(SC, P1, P2); - end; -end; - -procedure TAudio_bass.CaptureStop; -var - SC: integer; - P1: integer; - P2: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - P1 := Ini.CardList[SC].ChannelL; - P2 := Ini.CardList[SC].ChannelR; - if P1 > PlayersPlay then P1 := 0; - if P2 > PlayersPlay then P2 := 0; - if (P1 > 0) or (P2 > 0) then StopCard(SC); - end; - -end; - -//procedure TAudio_bass.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte); -procedure TAudio_bass.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -var - Error: integer; - ErrorMsg: string; -begin - if not BASS_RecordInit(RecordI) then - begin - Error := BASS_ErrorGetCode; - - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - - {Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg);} - Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', ' - + IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: ' - + ErrorMsg); - Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg); - - - end - else - begin - Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256); - end; -end; - -procedure TAudio_bass.StopCard(Card: byte); -begin - // TODO : jb_linux replace with something other than bass - BASS_RecordSetDevice(Card); - BASS_RecordFree; -end; - -function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end - else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TAudio_bass.GetFFTData: TFFTData; -var - Data: TFFTData; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); -end; - -function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); -end; - - -{* - -Sorry guys... this is my mess :( -Im going to try and get ffmpeg to handle audio playback ( at least for linux ) -and Im going to implement it nicly along side BASS, in TAudio_bass ( where I can ) - -http://www.dranger.com/ffmpeg/ffmpeg.html -http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - -http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*} -{* -function TAudio_bass.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; -var - lFormatCtx : PAVFormatContext; -begin - -(* - if(SDL_OpenAudio(&wanted_spec, &spec) < 0) - begin - fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); - writeln( 'SDL_OpenAudio' ); - exit; - end; -*) - -(* - if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) - begin - writeln( 'Unable to open file '+ aFileName ); - exit; - end; - - // Retrieve stream information - if ( av_find_stream_info(pFormatCtx) < 0 ) - begin - writeln( 'Unable to Retrieve stream information' ); - exit; - end; -*) - -end; *} - -initialization - singleton_MusicBass := TAudio_bass.create(); - - writeln( 'UAudio_Bass - Register Playback' ); - AudioManager.add( IAudioPlayback( singleton_MusicBass ) ); - - writeln( 'UAudio_Bass - Register Input' ); - AudioManager.add( IAudioInput( singleton_MusicBass ) ); - -finalization - writeln( 'UAudio_Bass - UnRegister Playback' ); - AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) ); - - writeln( 'UAudio_Bass - UnRegister Input' ); - AudioManager.Remove( IAudioInput( singleton_MusicBass ) ); - -end. +unit UAudio_bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +type +{$IFDEF UseBASSInput} + TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput) +{$ELSE} + TAudio_bass = class( TInterfacedObject, IAudioPlayback) +{$ENDIF} + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + + public + Bass: hStream; + function GetName: String; + + {IAudioOutput interface} + + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function getPosition: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + + {IAudioInput interface} + {$IFDEF UseBASSInput} + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + {$ENDIF} + end; + +{$IFDEF UseBASSInput} + TBassSoundCard = class(TGenericSoundCard) + RecordStream: HSTREAM; + end; +{$ENDIF} + + +var + singleton_MusicBass : IAudioPlayback; + +function TAudio_bass.GetName: String; +begin + result := 'BASS'; +end; + +procedure TAudio_bass.InitializePlayback; +var + Pet: integer; + S: integer; +begin + writeln( 'TAudio_bass.InitializePlayback' ); +// Log.BenchmarkStart(4); +// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + writeln( 'TAudio_bass BASS_Init' ); + if not BASS_Init(1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'Error'); + Exit; + end; + +// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + +// Log.LogStatus('Loading Sounds', 'Music Initialize'); + + writeln( 'TAudio_bass LoadSoundFromFile' ); +// Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + +// Log.BenchmarkEnd(4); +// Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TAudio_bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudio_bass.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_bass.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_bass.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_bass.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TAudio_bass.MoveTo(Time: real); +var + bytes: integer; +begin + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_bass.Play; +begin + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; +end; + +procedure TAudio_bass.Pause; //Pause Mod +begin + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; +end; + +procedure TAudio_bass.Stop; +begin + Bass_ChannelStop(Bass); +end; + +procedure TAudio_bass.Close; +begin + Bass_StreamFree(Bass); +end; + +function TAudio_bass.Length: real; +var + bytes: integer; +begin + Result := 60; + + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); +end; + +function TAudio_bass.getPosition: real; +var + bytes: integer; +begin + Result := 0; + + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +end; + +function TAudio_bass.Finished: boolean; +begin + Result := false; + + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +end; + +procedure TAudio_bass.PlayStart; +begin + BASS_ChannelPlay(BassStart, True); +end; + +procedure TAudio_bass.PlayBack; +begin + BASS_ChannelPlay(BassBack, True);// then +end; + +procedure TAudio_bass.PlaySwoosh; +begin + BASS_ChannelPlay(BassSwoosh, True); +end; + +procedure TAudio_bass.PlayChange; +begin + BASS_ChannelPlay(BassChange, True); +end; + +procedure TAudio_bass.PlayOption; +begin + BASS_ChannelPlay(BassOption, True); +end; + +procedure TAudio_bass.PlayClick; +begin + BASS_ChannelPlay(BassClick, True); +end; + +procedure TAudio_bass.PlayDrum; +begin + BASS_ChannelPlay(BassDrum, True); +end; + +procedure TAudio_bass.PlayHihat; +begin + BASS_ChannelPlay(BassHihat, True); +end; + +procedure TAudio_bass.PlayClap; +begin + BASS_ChannelPlay(BassClap, True); +end; + +procedure TAudio_bass.PlayShuffle; +begin + BASS_ChannelPlay(BassShuffle, True); +end; + +procedure TAudio_bass.StopShuffle; +begin + BASS_ChannelStop(BassShuffle); +end; + +function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TAudio_bass.GetFFTData: TFFTData; +var + Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +end; + +function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); +end; + +{$IFDEF UseBASSInput} + +procedure TAudio_bass.InitializeRecord; +var + device: integer; + Descr: string; + input: integer; + input2: integer; + InputName: PChar; + Flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input + No: integer; + +function isDuplicate(Desc: String): Boolean; +var + I: Integer; +begin + Result := False; + //Check for Soundcard with same Description + For I := 0 to SC-1 do + begin + if (Recording.SoundCard[I].Description = Desc) then + begin + Result := True; + Break; + end; + end; +end; + +begin + with Recording do + begin + // checks for recording devices and puts them into an array + SetLength(SoundCard, 0); + + SC := 0; + Descr := BASS_RecordGetDeviceDescription(SC); + + while (Descr <> '') do + begin + //If there is another SoundCard with the Same ID, Search an available Name + if (IsDuplicate(Descr)) then + begin + No:= 1; //Count of SoundCards with same Name + Repeat + Inc(No) + Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + + //Set Description + Descr := Descr + ' (' + InttoStr(No) + ')'; + end; + + SetLength(SoundCard, SC+1); + + // TODO: free object on termination + SoundCard[SC] := TBassSoundCard.Create(); + SoundCard[SC].Description := Descr; + + //Get Recording Inputs + SCI := 0; + BASS_RecordInit(SC); + + InputName := BASS_RecordGetInputName(SCI); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then + begin + InputName := 'Microphone'; + end; + {$ENDIF} + + SetLength(SoundCard[SC].Input, 1); + SoundCard[SC].Input[SCI].Name := InputName; + + // process each input + while (InputName <> nil) do + begin + Flags := BASS_RecordGetInput(SCI); + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then + begin + SetLength(SoundCard[SC].Input, SCI+1); + SoundCard[SC].Input[SCI].Name := InputName; + end; + + //Set Mic Index + if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then + SoundCard[SC].MicInput := SCI; + + Inc(SCI); + InputName := BASS_RecordGetInputName(SCI); + end; + + BASS_RecordFree; + + Inc(SC); + Descr := BASS_RecordGetDeviceDescription(SC); + end; // while + end; // with Recording +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_bass.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_bass.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; Card: Cardinal): boolean; stdcall; +begin + Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); + Result := true; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudio_bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: integer; + ErrorMsg: string; + bassSoundCard: TBassSoundCard; +begin + if not BASS_RecordInit(Card) then + begin + Error := BASS_ErrorGetCode; + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); + Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); + end + else + begin + bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); + bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; + bassSoundCard.CaptureSoundRight := CaptureSoundRight; + + // capture in 44.1kHz/stereo/16bit and a 20ms callback period + bassSoundCard.RecordStream := + BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); + end; +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudio_bass.StopCard(Card: byte); +begin + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + +{$ENDIF} + + +initialization + singleton_MusicBass := TAudio_bass.create(); + + writeln( 'UAudio_Bass - Register' ); + AudioManager.add( singleton_MusicBass ); + +finalization + writeln( 'UAudio_Bass - UnRegister' ); + AudioManager.Remove( singleton_MusicBass ); + +end. -- cgit v1.2.3 From dcbfb30a62776ffa128f620235a8bacf6137e0d5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 21:52:18 +0000 Subject: - bugfix: tried to access array element -1 if video contained no audio-stream git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@670 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 65dbc0a2..6c9458f9 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -487,7 +487,11 @@ begin writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); end; - aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; + // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error + // Just a temporary workaround for now + aCodecCtx := nil; + if( AudioStreamIndex >= 0) then + aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; {$ifdef FFMpegAudio} // This is the audio ffmpeg audio support Jay is working on. @@ -683,11 +687,11 @@ initialization singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); writeln( 'UVideo_FFMpeg - Register Playback' ); - AudioManager.add( IVideoPlayback( singleton_VideoFFMpeg ) ); + AudioManager.add( singleton_VideoFFMpeg ); finalization - AudioManager.Remove( IVideoPlayback( singleton_VideoFFMpeg ) ); + AudioManager.Remove( singleton_VideoFFMpeg ); end. -- cgit v1.2.3 From 47d6da8f4e8eb47e3c9b26b7d231d91f3cebafd0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 22:03:49 +0000 Subject: - compatibility changes for fpc 2.2.0 and lazarus 0.9.24. Changes are enabled if {$DEFINE LAZARUS_V0924} and/or {$DEFINE FPC_V220} are defined in switches.inc. - this is a very ugly HACK and should be replaced by something different (not in switches.inc and some sort of {$IF FPC_VERSION > VERSION(2, 2, 0)} git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@672 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 182 ++++++++++++++++++++++------------- Game/Code/Classes/USongs.pas | 2 +- Game/Code/Classes/Ulazjpeg.pas | 31 ++++++ 3 files changed, 148 insertions(+), 67 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 741662cd..8119346e 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -1,66 +1,116 @@ -unit UPlatformLinux; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes, UPlatform; - -type - - TPlatformLinux = class(TPlatform) - public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - end; - -implementation - -uses SysUtils, oldlinux; - -Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; -var - i : Integer; - TheDir : oldlinux.pdir; - ADirent : oldlinux.pDirent; - Entry : Longint; - info : oldlinux.stat; - lAttrib : integer; -begin - i := 0; - Filter := LowerCase(Filter); - - TheDir := oldlinux.opendir( Dir ); - if Assigned(TheDir) then - repeat - ADirent := oldlinux.ReadDir(TheDir); - - If Assigned(ADirent) and (ADirent^.name <> '.') and (ADirent^.name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.name); - if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.name)) > 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - Until ADirent = nil; - - oldlinux.CloseDir(TheDir); -end; - -end. +unit UPlatformLinux; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatformLinux = class(TPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + end; + +implementation + +uses +{$IFNDEF FPC_V220} + oldlinux, +{$ELSE} + BaseUnix, +{$ENDIF} + SysUtils; + +{$IFDEF FPC_V220} +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : pDir; + ADirent : pDirent; + Entry : Longint; + //info : oldlinux.stat; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FpOpenDir( Dir ); + if Assigned(TheDir) then + repeat + ADirent := FpReadDir(TheDir^); + + If Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + Until ADirent = nil; + + FpCloseDir(TheDir^); +end; +{$ELSE} +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; + Entry : Longint; + info : oldlinux.stat; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := oldlinux.opendir( Dir ); + if Assigned(TheDir) then + repeat + ADirent := oldlinux.ReadDir(TheDir); + + If Assigned(ADirent) and (ADirent^.name <> '.') and (ADirent^.name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + Until ADirent = nil; + + oldlinux.CloseDir(TheDir); +end; +{$ENDIF} + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 0ffa2a8d..3ac32dda 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -22,7 +22,7 @@ uses {$endif} {$ELSE} {$IFNDEF DARWIN} - oldlinux, +// oldlinux, syscall, {$ENDIF} baseunix, diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas index 1f6d8b99..d63ce753 100644 --- a/Game/Code/Classes/Ulazjpeg.pas +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -17,6 +17,7 @@ unit Ulazjpeg; {$mode objfpc}{$H+} +{$I switches.inc} interface @@ -33,9 +34,17 @@ type FProgressiveEncoding: boolean; FQuality: TJPEGQualityRange; protected +{$IFDEF LAZARUS_V0924} + procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; +{$ELSE} procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; +{$ENDIF} procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; +{$IFDEF LAZARUS_V0924} + procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; +{$ELSE} procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; +{$ENDIF} public constructor Create; override; class function GetFileExtensions: string; override; @@ -56,15 +65,26 @@ implementation { TJPEGImage } +{$IFDEF LAZARUS_V0924} +procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); +{$ELSE} procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); +{$ENDIF} var JPEGReader: TFPReaderJPEG; begin if ImgReader is TFPReaderJPEG then begin JPEGReader:=TFPReaderJPEG(ImgReader); JPEGReader.Performance:=Performance; +{$IFDEF LAZARUS_V0924} + JPEGReader.OnProgress:=@Progress; +{$ENDIF} end; +{$IFDEF LAZARUS_V0924} + inherited InitFPImageReader(IntfImg, ImgReader); +{$ELSE} inherited InitFPImageReader(ImgReader); +{$ENDIF} end; procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); @@ -78,7 +98,11 @@ begin inherited FinalizeFPImageReader(ImgReader); end; +{$IFDEF LAZARUS_V0924} +procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); +{$ELSE} procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); +{$ENDIF} var JPEGWriter: TFPWriterJPEG; begin @@ -87,8 +111,15 @@ begin if JPEGWriter<>nil then ; JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; JPEGWriter.CompressionQuality:=CompressionQuality; +{$IFDEF LAZARUS_V0924} + JPEGWriter.OnProgress:=@Progress; +{$ENDIF} end; +{$IFDEF LAZARUS_V0924} + inherited InitFPImageWriter(IntfImg, ImgWriter); +{$ELSE} inherited InitFPImageWriter(ImgWriter); +{$ENDIF} end; class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; -- cgit v1.2.3 From 6a6ef888e1132505da264e395d2c1ca08fffecc5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 5 Dec 2007 22:51:01 +0000 Subject: - music-visualization support added. - hardcoded to projectm at the moment. - needs a plugin-structure makeover git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@677 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVisualizer.pas | 201 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 201 insertions(+) create mode 100644 Game/Code/Classes/UVisualizer.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas new file mode 100644 index 00000000..3bea8f54 --- /dev/null +++ b/Game/Code/Classes/UVisualizer.pas @@ -0,0 +1,201 @@ +{############################################################################ +# Visualizer support for UltraStar deluxe # +# # +# Created by hennymcc # +# based on UVideo.pas # +#############################################################################} + +unit UVisualizer; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses SDL, + UGraphicClasses, + textgl, + math, + OpenGL12, + SysUtils, + UIni, + {$ifdef DebugDisplay} + dialogs, + {$ENDIF} + projectM, + windows; + +procedure Init; +procedure VisualizerStart; +procedure VisualizerStop; +procedure VisualizerGetFrame(Time: Extended); +procedure VisualizerDrawGL(Screen: integer); +procedure VisualizerTogglePause; + +const + VisualWidth = 640; + VisualHeight = 480; + gx = 32; + gy = 24; + fps = 30; + texsize = 512; + +var + pm: PProjectM; + VisualizerStarted, VisualizerPaused: Boolean; + VisualTex: glUint; + pcm_data: TPCM16; + hRC: Integer; + hDC: Integer; + +implementation + +procedure Init; +begin + VisualizerStarted := False; + VisualizerPaused := False; + glGenTextures(1, PglUint(@VisualTex)); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); +end; + +procedure VisualizerStart; +begin +exit; + VisualizerStarted := True; + + New(pm); + projectM_reset(pm); + + pm^.fullscreen := 0; + pm^.renderTarget^.texsize := texsize; + pm^.gx := gx; + pm^.gy := gy; + pm^.fps := fps; + pm^.renderTarget^.usePbuffers := 0; + + pm^.fontURL := PChar('Visuals\fonts'); + pm^.presetURL := PChar('Visuals\presets'); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + projectM_init(pm); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + projectM_resetGL(pm, VisualWidth, VisualHeight); + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + glPopAttrib(); +end; + +procedure VisualizerStop; +begin + if VisualizerStarted then begin + VisualizerStarted := False; + Dispose(pm); + end; +end; + +procedure VisualizerTogglePause; +begin + if VisualizerPaused then VisualizerPaused:=False + else VisualizerPaused:=True; +end; + +procedure VisualizerGetFrame(Time: Extended); +var + i: integer; +begin + exit; + + if not VisualizerStarted then Exit; + if VisualizerPaused then Exit; + + Randomize(); + + for i := 0 to 511 do + begin + pcm_data[0][i] := RandomRange(High(Smallint), Low(Smallint)); + pcm_data[1][i] := pcm_data[0][i]; + end; + addPCM16(pcm_data); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + renderFrame(pm); + glFlush(); + { + glBindTexture(GL_TEXTURE_2D, VisualTex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); + } + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + glPopAttrib(); + + glClear(GL_DEPTH_BUFFER_BIT); + + { + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(-1, -1); + glTexCoord2f(1, 0); glVertex2f( 1, -1); + glTexCoord2f(1, 1); glVertex2f( 1, 1); + glTexCoord2f(0, 1); glVertex2f(-1, 1); + glEnd(); + glDisable(GL_TEXTURE_2D); + } +end; + +procedure VisualizerDrawGL(Screen: integer); +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 VisualizerStarted then Exit; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glbegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(400-VisualWidth/2, 300-VisualHeight/2); + glTexCoord2f(0, 1); + glVertex2f(400-VisualWidth/2, 300+VisualHeight/2); + glTexCoord2f(1, 1); + glVertex2f(400+VisualWidth/2, 300+VisualHeight/2); + glTexCoord2f(1, 0); + glVertex2f(400+VisualWidth/2, 300-VisualHeight/2); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); +} +end; + +end. -- cgit v1.2.3 From 486ad8796acc5883ef83f3a78cd615f6711d77f0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 6 Dec 2007 09:39:49 +0000 Subject: conformed projectM to IVideoPlayback still needs a little work. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@678 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMedia_dummy.pas | 8 +- Game/Code/Classes/UMusic.pas | 5 +- Game/Code/Classes/UPlatform.pas | 11 ++- Game/Code/Classes/UVideo.pas | 8 +- Game/Code/Classes/UVisualizer.pas | 157 +++++++++++++++++++++++++++++-------- 5 files changed, 140 insertions(+), 49 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 42a3f1b9..630b497e 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -47,8 +47,8 @@ type procedure MoveTo(Time: real); function getPosition: real; - procedure FFmpegGetFrame(Time: Extended); - procedure FFmpegDrawGL(Screen: integer); + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); // IAudioInput procedure InitializeRecord; @@ -95,11 +95,11 @@ begin end; -procedure Tmedia_dummy.FFmpegGetFrame(Time: Extended); +procedure Tmedia_dummy.GetFrame(Time: Extended); begin end; -procedure Tmedia_dummy.FFmpegDrawGL(Screen: integer); +procedure Tmedia_dummy.DrawGL(Screen: integer); begin end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index feba3f61..18ec2944 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -123,8 +123,8 @@ type *) procedure init(); - procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure FFmpegDrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC end; @@ -265,6 +265,7 @@ begin // ( not assigned( singleton_AudioInput ) ) then begin singleton_AudioInput := IAudioInput( lTmpInterface ); + Writeln(singleton_AudioInput.GetName); end; // if this interface is a Input, then set it as the default used diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas index 878c1ec2..a06914d0 100644 --- a/Game/Code/Classes/UPlatform.pas +++ b/Game/Code/Classes/UPlatform.pas @@ -18,10 +18,10 @@ uses Classes; type TDirectoryEntry = Record - Name : WideString; - IsDirectory : Boolean; - IsFile : Boolean; - end; + Name : WideString; + IsDirectory : Boolean; + IsFile : Boolean; + end; TDirectoryEntryArray = Array of TDirectoryEntry; @@ -81,6 +81,5 @@ initialization {$ENDIF} finalization - - Platform.Free; + freeandnil( Platform ); end. diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 6c9458f9..c2e42224 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -110,8 +110,8 @@ type procedure MoveTo(Time: real); function getPosition: real; - procedure FFmpegGetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure FFmpegDrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC end; @@ -192,7 +192,7 @@ end; -procedure TVideoPlayback_ffmpeg.FFmpegGetFrame(Time: Extended); +procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended); var FrameFinished: Integer; AVPacket: TAVPacket; @@ -355,7 +355,7 @@ begin end; end; -procedure TVideoPlayback_ffmpeg.FFmpegDrawGL(Screen: integer); +procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer); begin // have a nice black background to draw on (even if there were errors opening the vid) if Screen=1 then diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 3bea8f54..1905358f 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -2,6 +2,7 @@ # Visualizer support for UltraStar deluxe # # # # Created by hennymcc # +# Slight modifications by Jay Binks # # based on UVideo.pas # #############################################################################} @@ -24,46 +25,122 @@ uses SDL, dialogs, {$ENDIF} projectM, + UMusic, windows; -procedure Init; -procedure VisualizerStart; -procedure VisualizerStop; -procedure VisualizerGetFrame(Time: Extended); -procedure VisualizerDrawGL(Screen: integer); -procedure VisualizerTogglePause; +implementation + +var + singleton_VideoProjectM : IVideoPlayback; const - VisualWidth = 640; - VisualHeight = 480; - gx = 32; - gy = 24; - fps = 30; - texsize = 512; + VisualWidth = 800; // 640 + VisualHeight = 600; // 480 + gx = 32; + gy = 24; + fps = 30; + texsize = 512; -var - pm: PProjectM; - VisualizerStarted, VisualizerPaused: Boolean; - VisualTex: glUint; - pcm_data: TPCM16; - hRC: Integer; - hDC: Integer; +type + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback ) + + pm : PProjectM; -implementation + VisualizerStarted , + VisualizerPaused : Boolean; -procedure Init; -begin + VisualTex : glUint; + pcm_data : TPCM16; + hRC : Integer; + hDC : Integer; + + procedure VisualizerStart; + procedure VisualizerStop; + + procedure VisualizerTogglePause; + public + constructor create(); + function GetName: String; + + procedure init(); + + function Open( aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure MoveTo(Time: real); + function getPosition: real; + + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + end; + + +constructor TVideoPlayback_ProjectM.create(); +begin +end; + + +procedure TVideoPlayback_ProjectM.init(); +begin + writeln( 'TVideoPlayback_ProjectM - INITIALIZE !!!!!!!!' ); + VisualizerStarted := False; - VisualizerPaused := False; + VisualizerPaused := False; + glGenTextures(1, PglUint(@VisualTex)); glBindTexture(GL_TEXTURE_2D, VisualTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); end; -procedure VisualizerStart; +function TVideoPlayback_ProjectM.GetName: String; +begin + result := 'ProjectM'; +end; + + +function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed begin -exit; + VisualizerStart(); + result := true; +end; + +procedure TVideoPlayback_ProjectM.Close; +begin +end; + +procedure TVideoPlayback_ProjectM.Play; +begin + VisualizerStart(); +end; + +procedure TVideoPlayback_ProjectM.Pause; +begin + VisualizerTogglePause(); +end; + +procedure TVideoPlayback_ProjectM.Stop; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.MoveTo(Time: real); +begin +end; + +function TVideoPlayback_ProjectM.getPosition: real; +begin + result := 0; +end; + +procedure TVideoPlayback_ProjectM.VisualizerStart; +begin +//exit; VisualizerStarted := True; New(pm); @@ -76,7 +153,7 @@ exit; pm^.fps := fps; pm^.renderTarget^.usePbuffers := 0; - pm^.fontURL := PChar('Visuals\fonts'); + pm^.fontURL := PChar('Visuals\fonts'); pm^.presetURL := PChar('Visuals\presets'); glPushAttrib(GL_ALL_ATTRIB_BITS); @@ -97,7 +174,7 @@ exit; glPopAttrib(); end; -procedure VisualizerStop; +procedure TVideoPlayback_ProjectM.VisualizerStop; begin if VisualizerStarted then begin VisualizerStarted := False; @@ -105,17 +182,17 @@ begin end; end; -procedure VisualizerTogglePause; +procedure TVideoPlayback_ProjectM.VisualizerTogglePause; begin if VisualizerPaused then VisualizerPaused:=False else VisualizerPaused:=True; end; -procedure VisualizerGetFrame(Time: Extended); +procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); var i: integer; begin - exit; +// exit; if not VisualizerStarted then Exit; if VisualizerPaused then Exit; @@ -168,9 +245,11 @@ begin } end; -procedure VisualizerDrawGL(Screen: integer); +procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); begin -{ + + exit; + // 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); @@ -195,7 +274,19 @@ begin glEnd; glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); -} + end; + +initialization + singleton_VideoProjectM := TVideoPlayback_ProjectM.create(); + + writeln( 'UVideoProjectM - Register Playback' ); + AudioManager.add( singleton_VideoProjectM ); + +finalization + AudioManager.Remove( singleton_VideoProjectM ); + + + end. -- cgit v1.2.3 From 27ca028ea19879bb3b109c58bae86b61e60b3370 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 6 Dec 2007 10:40:15 +0000 Subject: Visualizer changes (audio connection, some opengl fixes) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@679 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_bass.pas | 37 +++++++++++++++ Game/Code/Classes/UMedia_dummy.pas | 6 +++ Game/Code/Classes/UMusic.pas | 8 +++- Game/Code/Classes/UVisualizer.pas | 96 ++++++++++++++++++++++---------------- 4 files changed, 106 insertions(+), 41 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index bcf01f92..69278cca 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -100,6 +100,9 @@ type //Equalizer function GetFFTData: TFFTData; + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); @@ -384,6 +387,40 @@ begin BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); end; +{* + * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. + * Returns the number of frames (= stereo/mono sample) + *} +function TAudio_bass.GetPCMData(var data: TPCMData): Cardinal; +var + info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetInfo(Bass, info); + ZeroMemory(@data, sizeof(TPCMData)); + + if (info.chans = 1) then + begin + // mono file -> add stereo channel + { + nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); + // interleave data + //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); + } + result := 0; + end + else + begin + // stereo file + nBytes := BASS_ChannelGetData(Bass, @data, sizeof(TPCMData)); + end; + if(nBytes <= 0) then + result := 0 + else + result := nBytes div sizeof(TPCMStereoSample); +end; + function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; var S: hStream; diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 630b497e..c5fb799c 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -57,6 +57,7 @@ type procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); procedure StopCard(Card: byte); function GetFFTData: TFFTData; + function GetPCMData(var data: TPCMData): Cardinal; // IAudioPlayback procedure InitializePlayback; @@ -167,6 +168,11 @@ function Tmedia_dummy.GetFFTData: TFFTData; begin end; +function Tmedia_dummy.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + // IAudioPlayback procedure Tmedia_dummy.InitializePlayback; begin diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 18ec2944..4acbb55a 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -83,7 +83,10 @@ type Source: array of string; end; - TFFTData = array [0..256] of Single; + TFFTData = array[0..256] of Single; + + TPCMStereoSample = array[0..1] of Smallint; + TPCMData = array[0..511] of TPCMStereoSample; hStream = Cardinal; @@ -165,6 +168,9 @@ type //Equalizer function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; end; IAudioInput = Interface diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 1905358f..0f2334ba 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -30,16 +30,19 @@ uses SDL, implementation +uses + UGraphic; + var singleton_VideoProjectM : IVideoPlayback; const - VisualWidth = 800; // 640 - VisualHeight = 600; // 480 gx = 32; gy = 24; fps = 30; texsize = 512; + visuals_Dir = 'Visuals'; // TODO: move this to a place common for all visualizers + projectM_Dir = visuals_Dir+'/projectM'; type TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback ) @@ -50,7 +53,7 @@ type VisualizerPaused : Boolean; VisualTex : glUint; - pcm_data : TPCM16; + PCMData : TPCMData; hRC : Integer; hDC : Integer; @@ -140,7 +143,6 @@ end; procedure TVideoPlayback_ProjectM.VisualizerStart; begin -//exit; VisualizerStarted := True; New(pm); @@ -153,8 +155,8 @@ begin pm^.fps := fps; pm^.renderTarget^.usePbuffers := 0; - pm^.fontURL := PChar('Visuals\fonts'); - pm^.presetURL := PChar('Visuals\presets'); + pm^.fontURL := PChar(projectM_Dir+'/fonts'); + pm^.presetURL := PChar(projectM_Dir+'/presets'); glPushAttrib(GL_ALL_ATTRIB_BITS); projectM_init(pm); @@ -164,7 +166,9 @@ begin glPushMatrix(); glMatrixMode(GL_TEXTURE); glPushMatrix(); - projectM_resetGL(pm, VisualWidth, VisualHeight); + + projectM_resetGL(pm, ScreenW, ScreenH); + glMatrixMode(GL_PROJECTION); glPopMatrix(); glMatrixMode(GL_MODELVIEW); @@ -191,21 +195,16 @@ end; procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); var i: integer; + nSamples: cardinal; begin -// exit; - if not VisualizerStarted then Exit; if VisualizerPaused then Exit; - Randomize(); - - for i := 0 to 511 do - begin - pcm_data[0][i] := RandomRange(High(Smallint), Low(Smallint)); - pcm_data[1][i] := pcm_data[0][i]; - end; - addPCM16(pcm_data); + // get audio data + nSamples := AudioPlayback.GetPCMData(PcmData); + addPCM16Data(PSmallInt(@PcmData), nSamples); + // store OpenGL state (might be messed up otherwise) glPushAttrib(GL_ALL_ATTRIB_BITS); glMatrixMode(GL_PROJECTION); glPushMatrix(); @@ -213,12 +212,17 @@ begin glPushMatrix(); glMatrixMode(GL_TEXTURE); glPushMatrix(); + + // let projectM render a frame renderFrame(pm); glFlush(); - { + + {$IFDEF UseTexture} glBindTexture(GL_TEXTURE_2D, VisualTex); glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); - } + {$ENDIF} + + // restore USDX OpenGL state glMatrixMode(GL_PROJECTION); glPopMatrix(); glMatrixMode(GL_MODELVIEW); @@ -227,41 +231,45 @@ begin glPopMatrix(); glPopAttrib(); + // discard projectM's depth buffer information (avoid overlay) glClear(GL_DEPTH_BUFFER_BIT); - - { - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - - glEnable(GL_TEXTURE_2D); - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glBindTexture(GL_TEXTURE_2D, VisualTex); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(-1, -1); - glTexCoord2f(1, 0); glVertex2f( 1, -1); - glTexCoord2f(1, 1); glVertex2f( 1, 1); - glTexCoord2f(0, 1); glVertex2f(-1, 1); - glEnd(); - glDisable(GL_TEXTURE_2D); - } end; procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); begin - - exit; - + {$IFDEF UseTexture} // 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); + glClearColor(0, 0, 0, 0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); end; // exit if there's nothing to draw if not VisualizerStarted then Exit; - glEnable(GL_TEXTURE_2D); + // setup display + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glLoadIdentity(); + gluOrtho2D(0, 1, 0, 1); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glLoadIdentity(); + glEnable(GL_BLEND); - glColor4f(1, 1, 1, 1); + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); glBindTexture(GL_TEXTURE_2D, VisualTex); + glColor4f(1, 1, 1, 1); + + // draw projectM frame + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(1, 0); glVertex2f(1, 0); + glTexCoord2f(1, 1); glVertex2f(1, 1); + glTexCoord2f(0, 1); glVertex2f(0, 1); + glEnd(); + + { glbegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(400-VisualWidth/2, 300-VisualHeight/2); @@ -272,9 +280,17 @@ begin glTexCoord2f(1, 0); glVertex2f(400+VisualWidth/2, 300-VisualHeight/2); glEnd; + } + glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); + // restore state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + {$ENDIF} end; -- cgit v1.2.3 From 553ee1ad981964a3689e6510d5813dbff0f2119c Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 6 Dec 2007 10:46:53 +0000 Subject: added "V" key to sing screen to start Visualization... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@681 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 23 +++++++++++------------ Game/Code/Classes/UVisualizer.pas | 26 ++++++++++++-------------- 2 files changed, 23 insertions(+), 26 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index c2e42224..62351e2d 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -96,22 +96,21 @@ type function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; public constructor create(); - function GetName: String; + function GetName: String; + procedure init(); - procedure init(); + function Open( aFileName : string): boolean; // true if succeed + procedure Close; - function Open( aFileName : string): boolean; // true if succeed - procedure Close; + procedure Play; + procedure Pause; + procedure Stop; - procedure Play; - procedure Pause; - procedure Stop; + procedure MoveTo(Time: real); + function getPosition: real; - procedure MoveTo(Time: real); - function getPosition: real; - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); end; diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 0f2334ba..6fb5b7a7 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -63,22 +63,21 @@ type procedure VisualizerTogglePause; public constructor create(); - function GetName: String; + procedure init(); + function GetName: String; - procedure init(); + function Open( aFileName : string): boolean; // true if succeed + procedure Close; - function Open( aFileName : string): boolean; // true if succeed - procedure Close; + procedure Play; + procedure Pause; + procedure Stop; - procedure Play; - procedure Pause; - procedure Stop; + procedure MoveTo(Time: real); + function getPosition: real; - procedure MoveTo(Time: real); - function getPosition: real; - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); end; @@ -188,8 +187,7 @@ end; procedure TVideoPlayback_ProjectM.VisualizerTogglePause; begin - if VisualizerPaused then VisualizerPaused:=False - else VisualizerPaused:=True; + VisualizerPaused := not VisualizerPaused; end; procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); -- cgit v1.2.3 From 886b7205df1355054eda3cb72b65c77ec8a40d73 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 6 Dec 2007 11:19:36 +0000 Subject: added [tab] to change visualization preset git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@682 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVisualizer.pas | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 6fb5b7a7..08e4b594 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -133,6 +133,39 @@ end; procedure TVideoPlayback_ProjectM.MoveTo(Time: real); begin + // this code MAY be able to be cut down... but Im not 100% sure.. + // in here, we cant realy move to a specific time, since its all random generated + // but a call to this function will change the preset, which changes the pattern + projectM_reset(pm); + + pm^.fullscreen := 0; + pm^.renderTarget^.texsize := texsize; + pm^.gx := gx; + pm^.gy := gy; + pm^.fps := fps; + pm^.renderTarget^.usePbuffers := 0; + + pm^.fontURL := PChar(projectM_Dir+'/fonts'); + pm^.presetURL := PChar(projectM_Dir+'/presets'); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + projectM_init(pm); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + + projectM_resetGL(pm, ScreenW, ScreenH); + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + glPopAttrib(); + end; function TVideoPlayback_ProjectM.getPosition: real; -- cgit v1.2.3 From be68ff31e2d10d5f29894c6ec4ed877c70c142a3 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 6 Dec 2007 12:26:05 +0000 Subject: gave priority to videos over Visualization... so now video plays back... and "V" will switch between Video ( or jpg ) background and visualization. this needs to be pressed on every song, as the state should be forgotten. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@687 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMedia_dummy.pas | 2 +- Game/Code/Classes/UMusic.pas | 24 ++++++++++++++++++++++-- Game/Code/Classes/UVisualizer.pas | 2 +- 3 files changed, 24 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index c5fb799c..4fc39d4e 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -29,7 +29,7 @@ var singleton_dummy : IVideoPlayback; type - Tmedia_dummy = class( TInterfacedObject, IVideoPlayback, IAudioPlayback, IAudioInput ) + Tmedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) private public constructor create(); diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 4acbb55a..2cdcc707 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -131,6 +131,10 @@ type end; + IVideoVisualization = Interface( IVideoPlayback ) + ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] + end; + IAudioPlayback = Interface( IGenericPlayback ) ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] procedure InitializePlayback; @@ -195,7 +199,8 @@ var // TODO : JB --- THESE SHOULD NOT BE GLOBAL procedure InitializeSound; - + +function Visualization(): IVideoPlayback; function VideoPlayback(): IVideoPlayback; function AudioPlayback(): IAudioPlayback; function AudioInput(): IAudioInput; @@ -210,9 +215,11 @@ uses // uLog; var - singleton_VideoPlayback : IVideoPlayback = nil; + singleton_VideoPlayback : IVideoPlayback = nil; + singleton_Visualization : IVideoPlayback = nil; singleton_AudioPlayback : IAudioPlayback = nil; singleton_AudioInput : IAudioInput = nil; + singleton_AudioManager : TInterfaceList = nil; @@ -230,6 +237,11 @@ begin result := singleton_VideoPlayback; end; +function Visualization(): IVideoPlayback; +begin + result := singleton_Visualization; +end; + function AudioPlayback(): IAudioPlayback; begin result := singleton_AudioPlayback; @@ -250,6 +262,7 @@ begin singleton_AudioPlayback := nil; singleton_AudioInput := nil; singleton_VideoPlayback := nil; + singleton_Visualization := nil; writeln( 'InitializeSound , Enumerate Registered Audio Interfaces' ); for iCount := 0 to AudioManager.Count - 1 do @@ -276,12 +289,19 @@ begin // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND + //( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) <> 0 ) AND ( true ) then // ( not assigned( singleton_VideoPlayback ) ) then begin singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); end; + if ( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_Visualization := IVideoPlayback( lTmpInterface ); + end; + end; end; diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 08e4b594..b6b3a1cc 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -45,7 +45,7 @@ const projectM_Dir = visuals_Dir+'/projectM'; type - TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback ) + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) pm : PProjectM; -- cgit v1.2.3 From 20e43a8aeb1c9ea5fe29d2b9c9e9842826d2c7d8 Mon Sep 17 00:00:00 2001 From: mogguh Date: Thu, 6 Dec 2007 22:02:02 +0000 Subject: Singscreen: pop up is now faster Scorescreen: minor graphic edits git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@690 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USingScores.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index c7213180..894f5782 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -212,9 +212,9 @@ begin oPositionCount := 0; oPlayerCount := 0; - Settings.Phase1Time := 1000; - Settings.Phase2Time := 2000; - Settings.Phase3Time := 2000; + Settings.Phase1Time := 350; // plop it up . -> [ ] + Settings.Phase2Time := 550; // shift it up ^[ ]^ + Settings.Phase3Time := 200; // increase score [s++] Settings.PopUpTex[0].TexNum := High(gluInt); Settings.PopUpTex[1].TexNum := High(gluInt); -- cgit v1.2.3 From 73a9bf99b8993aa69f3ed77b36b0236fb1cde2ed Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 6 Dec 2007 23:53:46 +0000 Subject: trying to get projectM to run in linux git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@692 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVisualizer.pas | 540 +++++++++++++++++++------------------- 1 file changed, 275 insertions(+), 265 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index b6b3a1cc..a49187e7 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -1,66 +1,65 @@ -{############################################################################ -# Visualizer support for UltraStar deluxe # -# # -# Created by hennymcc # -# Slight modifications by Jay Binks # -# based on UVideo.pas # -#############################################################################} - -unit UVisualizer; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses SDL, - UGraphicClasses, - textgl, - math, - OpenGL12, - SysUtils, - UIni, - {$ifdef DebugDisplay} - dialogs, - {$ENDIF} - projectM, - UMusic, - windows; - -implementation - -uses - UGraphic; - -var +{############################################################################ +# Visualizer support for UltraStar deluxe # +# # +# Created by hennymcc # +# Slight modifications by Jay Binks # +# based on UVideo.pas # +#############################################################################} + +unit UVisualizer; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses SDL, + UGraphicClasses, + textgl, + math, + OpenGL12, + SysUtils, + UIni, + {$ifdef DebugDisplay} + dialogs, + {$ENDIF} + projectM, + UMusic; + +implementation + +uses + UGraphic; + +var singleton_VideoProjectM : IVideoPlayback; - -const - gx = 32; - gy = 24; - fps = 30; - texsize = 512; - visuals_Dir = 'Visuals'; // TODO: move this to a place common for all visualizers - projectM_Dir = visuals_Dir+'/projectM'; - -type - TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) + +const + gx = 32; + gy = 24; + fps = 30; + texsize = 512; + visuals_Dir = 'Visuals'; // TODO: move this to a place common for all visualizers + projectM_Dir = visuals_Dir+'/projectM'; + +type + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) pm : PProjectM; - - VisualizerStarted , - VisualizerPaused : Boolean; - - VisualTex : glUint; - PCMData : TPCMData; - hRC : Integer; - hDC : Integer; + + VisualizerStarted , + VisualizerPaused : Boolean; + + VisualTex : glUint; + PCMData : TPCMData; + hRC : Integer; + hDC : Integer; procedure VisualizerStart; procedure VisualizerStop; - - procedure VisualizerTogglePause; + + procedure VisualizerTogglePause; public constructor create(); procedure init(); @@ -79,40 +78,44 @@ type procedure GetFrame(Time: Extended); procedure DrawGL(Screen: integer); end; - - -constructor TVideoPlayback_ProjectM.create(); + + +constructor TVideoPlayback_ProjectM.create(); begin end; - - -procedure TVideoPlayback_ProjectM.init(); + + +procedure TVideoPlayback_ProjectM.init(); begin writeln( 'TVideoPlayback_ProjectM - INITIALIZE !!!!!!!!' ); - VisualizerStarted := False; - VisualizerPaused := False; - - glGenTextures(1, PglUint(@VisualTex)); - glBindTexture(GL_TEXTURE_2D, VisualTex); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); -end; - -function TVideoPlayback_ProjectM.GetName: String; + VisualizerStarted := False; + VisualizerPaused := False; + + glGenTextures(1, PglUint(@VisualTex)); + glBindTexture(GL_TEXTURE_2D, VisualTex); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + + New(pm); + projectM_reset(pm); + +end; + +function TVideoPlayback_ProjectM.GetName: String; begin result := 'ProjectM'; end; - - -function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed -begin - VisualizerStart(); - result := true; -end; - -procedure TVideoPlayback_ProjectM.Close; + + +function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed +begin + VisualizerStart(); + result := true; +end; + +procedure TVideoPlayback_ProjectM.Close; begin end; @@ -137,33 +140,33 @@ begin // in here, we cant realy move to a specific time, since its all random generated // but a call to this function will change the preset, which changes the pattern projectM_reset(pm); - - pm^.fullscreen := 0; - pm^.renderTarget^.texsize := texsize; - pm^.gx := gx; - pm^.gy := gy; - pm^.fps := fps; - pm^.renderTarget^.usePbuffers := 0; - - pm^.fontURL := PChar(projectM_Dir+'/fonts'); - pm^.presetURL := PChar(projectM_Dir+'/presets'); - - glPushAttrib(GL_ALL_ATTRIB_BITS); - projectM_init(pm); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - projectM_resetGL(pm, ScreenW, ScreenH); - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); + + pm^.fullscreen := 0; + pm^.renderTarget^.texsize := texsize; + pm^.gx := gx; + pm^.gy := gy; + pm^.fps := fps; + pm^.renderTarget^.usePbuffers := 0; + + pm^.fontURL := PChar(projectM_Dir+'/fonts'); + pm^.presetURL := PChar(projectM_Dir+'/presets'); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + projectM_init(pm); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + + projectM_resetGL(pm, ScreenW, ScreenH); + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); glPopAttrib(); end; @@ -173,158 +176,165 @@ begin result := 0; end; -procedure TVideoPlayback_ProjectM.VisualizerStart; -begin - VisualizerStarted := True; - - New(pm); - projectM_reset(pm); - - pm^.fullscreen := 0; - pm^.renderTarget^.texsize := texsize; - pm^.gx := gx; - pm^.gy := gy; - pm^.fps := fps; - pm^.renderTarget^.usePbuffers := 0; - - pm^.fontURL := PChar(projectM_Dir+'/fonts'); - pm^.presetURL := PChar(projectM_Dir+'/presets'); - - glPushAttrib(GL_ALL_ATTRIB_BITS); - projectM_init(pm); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - projectM_resetGL(pm, ScreenW, ScreenH); - - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); - glPopAttrib(); -end; - -procedure TVideoPlayback_ProjectM.VisualizerStop; -begin - if VisualizerStarted then begin - VisualizerStarted := False; - Dispose(pm); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerTogglePause; -begin - VisualizerPaused := not VisualizerPaused; -end; - -procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); -var - i: integer; - nSamples: cardinal; -begin - if not VisualizerStarted then Exit; - if VisualizerPaused then Exit; - - // get audio data - nSamples := AudioPlayback.GetPCMData(PcmData); - addPCM16Data(PSmallInt(@PcmData), nSamples); - - // store OpenGL state (might be messed up otherwise) - glPushAttrib(GL_ALL_ATTRIB_BITS); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - // let projectM render a frame - renderFrame(pm); - glFlush(); - - {$IFDEF UseTexture} - glBindTexture(GL_TEXTURE_2D, VisualTex); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); - {$ENDIF} - - // restore USDX OpenGL state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); - glPopAttrib(); - - // discard projectM's depth buffer information (avoid overlay) - glClear(GL_DEPTH_BUFFER_BIT); -end; - -procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); -begin - {$IFDEF UseTexture} - // 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 VisualizerStarted then Exit; - - // setup display - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glLoadIdentity(); - gluOrtho2D(0, 1, 0, 1); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glLoadIdentity(); - - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glBindTexture(GL_TEXTURE_2D, VisualTex); - glColor4f(1, 1, 1, 1); - - // draw projectM frame - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(1, 0); glVertex2f(1, 0); - glTexCoord2f(1, 1); glVertex2f(1, 1); - glTexCoord2f(0, 1); glVertex2f(0, 1); - glEnd(); - - { - glbegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(400-VisualWidth/2, 300-VisualHeight/2); - glTexCoord2f(0, 1); - glVertex2f(400-VisualWidth/2, 300+VisualHeight/2); - glTexCoord2f(1, 1); - glVertex2f(400+VisualWidth/2, 300+VisualHeight/2); - glTexCoord2f(1, 0); - glVertex2f(400+VisualWidth/2, 300-VisualHeight/2); - glEnd; - } - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // restore state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - {$ENDIF} -end; - - +procedure TVideoPlayback_ProjectM.VisualizerStart; +begin + VisualizerStarted := True; + +// New(pm); +// projectM_reset(pm); + + writeln('Render Target'); + writeln( inttostr( integer( assigned(pm^.renderTarget) ) ) ); + + pm^.fullscreen := 0; + pm^.gx := gx; + pm^.gy := gy; + pm^.fps := fps; + + if assigned(pm^.renderTarget) then + begin + pm^.renderTarget^.texsize := texsize; + pm^.renderTarget^.usePbuffers := 0; + end; + + pm^.fontURL := PChar(projectM_Dir+'/fonts'); + pm^.presetURL := PChar(projectM_Dir+'/presets'); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + projectM_init(pm); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + + projectM_resetGL(pm, ScreenW, ScreenH); + + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + glPopAttrib(); +end; + +procedure TVideoPlayback_ProjectM.VisualizerStop; +begin + if VisualizerStarted then begin + VisualizerStarted := False; + Dispose(pm); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerTogglePause; +begin + VisualizerPaused := not VisualizerPaused; +end; + +procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); +var + i: integer; + nSamples: cardinal; +begin + if not VisualizerStarted then Exit; + if VisualizerPaused then Exit; + + // get audio data + nSamples := AudioPlayback.GetPCMData(PcmData); + addPCM16Data(PSmallInt(@PcmData), nSamples); + + // store OpenGL state (might be messed up otherwise) + glPushAttrib(GL_ALL_ATTRIB_BITS); + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glMatrixMode(GL_TEXTURE); + glPushMatrix(); + + // let projectM render a frame + renderFrame(pm); + glFlush(); + + {$IFDEF UseTexture} + glBindTexture(GL_TEXTURE_2D, VisualTex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); + {$ENDIF} + + // restore USDX OpenGL state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + glPopAttrib(); + + // discard projectM's depth buffer information (avoid overlay) + glClear(GL_DEPTH_BUFFER_BIT); +end; + +procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); +begin + {$IFDEF UseTexture} + // 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 VisualizerStarted then Exit; + + // setup display + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glLoadIdentity(); + gluOrtho2D(0, 1, 0, 1); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glLoadIdentity(); + + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glColor4f(1, 1, 1, 1); + + // draw projectM frame + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(1, 0); glVertex2f(1, 0); + glTexCoord2f(1, 1); glVertex2f(1, 1); + glTexCoord2f(0, 1); glVertex2f(0, 1); + glEnd(); + + { + glbegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(400-VisualWidth/2, 300-VisualHeight/2); + glTexCoord2f(0, 1); + glVertex2f(400-VisualWidth/2, 300+VisualHeight/2); + glTexCoord2f(1, 1); + glVertex2f(400+VisualWidth/2, 300+VisualHeight/2); + glTexCoord2f(1, 0); + glVertex2f(400+VisualWidth/2, 300-VisualHeight/2); + glEnd; + } + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // restore state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + {$ENDIF} +end; + + initialization singleton_VideoProjectM := TVideoPlayback_ProjectM.create(); @@ -334,6 +344,6 @@ initialization finalization AudioManager.Remove( singleton_VideoProjectM ); - - -end. + + +end. -- cgit v1.2.3 From 842af29c79390c0f78c2f004b463fe555ab01430 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 7 Dec 2007 00:37:39 +0000 Subject: oops didnt mean to commit that. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@693 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVisualizer.pas | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index a49187e7..fc5eacbf 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -98,9 +98,6 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - New(pm); - projectM_reset(pm); - end; function TVideoPlayback_ProjectM.GetName: String; @@ -180,8 +177,8 @@ procedure TVideoPlayback_ProjectM.VisualizerStart; begin VisualizerStarted := True; -// New(pm); -// projectM_reset(pm); + New(pm); + projectM_reset(pm); writeln('Render Target'); writeln( inttostr( integer( assigned(pm^.renderTarget) ) ) ); -- cgit v1.2.3 From 2e41ddbf9dc84772cdc9c8a9ab80d4861d6e4177 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 7 Dec 2007 02:32:44 +0000 Subject: Fixed some linux visualizer errors git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@694 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_portaudio.pas | 863 ++++++++++++++++----------------- Game/Code/Classes/UMedia_dummy.pas | 2 + Game/Code/Classes/UVisualizer.pas | 18 +- 3 files changed, 436 insertions(+), 447 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_portaudio.pas b/Game/Code/Classes/UAudio_portaudio.pas index 9ed2107d..941d90d1 100644 --- a/Game/Code/Classes/UAudio_portaudio.pas +++ b/Game/Code/Classes/UAudio_portaudio.pas @@ -1,434 +1,429 @@ -unit UAudio_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - portaudio, - {$IFDEF UsePortmixer} - portmixer, - {$ENDIF} - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; -{ -type - TPaHostApiIndex = PaHostApiIndex; - TPaDeviceIndex = PaDeviceIndex; - PPaStream = ^PaStreamPtr; - PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; - TPaStreamCallbackFlags = PaStreamCallbackFlags; - TPaHostApiTypeId = PaHostApiTypeId; - PPaHostApiInfo = ^PaHostApiInfo; - PPaDeviceInfo = ^PaDeviceInfo; - TPaError = PaError; - TPaStreamParameters = PaStreamParameters; -} -type - TAudio_Portaudio = class( TInterfacedObject, IAudioInput ) - private - function GetPreferredApiIndex(): TPaHostApiIndex; - public - function GetName: String; - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); - end; - - TPortaudioSoundCard = class(TGenericSoundCard) - RecordStream: PPaStream; - DeviceIndex: TPaDeviceIndex; - end; - -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - -var - singleton_MusicPortaudio : IAudioInput; - -const - sampleRate: Double = 44100.; - -{* the default API used by Portaudio is the least common denominator - * and might lack efficiency. ApiPreferenceOrder defines the order of - * preferred APIs to use. The first API-type in the list is tried first. If it's - * not available the next is tried, ... - * If none of the preferred APIs was found the default API is used. - * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi - * as an array's only member if you do not have any preferences. - * paDefaultApi also terminates a preferences list but this is optional. - *} -const - paDefaultApi = -1; -var - ApiPreferenceOrder: -{$IF Defined(WIN32)} - // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment - // Note2: Windows Default-API is MME - //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); - array[0..0] of TPaHostApiTypeId = ( paDirectSound ); -{$ELSEIF Defined(LINUX)} - // Note1: Portmixer has no mixer support for paJACK at the moment - // Note2: Not tested, but ALSA might be better than OSS. - array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); -{$ELSEIF Defined(DARWIN)} - // Note: Not tested. - //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$ELSE} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$IFEND} - -function TAudio_Portaudio.GetName: String; -begin - result := 'Portaudio'; -end; - -function TAudio_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; -var - i: integer; -begin - result := -1; - - // select preferred sound-API - for i:= 0 to High(ApiPreferenceOrder) do - begin - if(ApiPreferenceOrder[i] <> paDefaultApi) then begin - // check if API is available - result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); - if(result >= 0) then - break; - end; - end; - - // None of the preferred APIs is available -> use default - if(result < 0) then begin - result := Pa_GetDefaultHostApi(); - end; -end; - -// TODO: should be a function with boolean return type -procedure TAudio_Portaudio.InitializeRecord; -var - i: integer; - apiIndex: TPaHostApiIndex; - apiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - inputCnt: integer; - inputName: string; - SC: integer; // soundcard - SCI: integer; // soundcard input - err: TPaError; - errMsg: string; - paSoundCard: TPortaudioSoundCard; - inputParams: TPaStreamParameters; - stream: PPaStream; - {$IFDEF UsePortmixer} - mixer: PPxMixer; - {$ENDIF} -begin - // TODO: call Pa_Terminate() on termination - err := Pa_Initialize(); - if(err <> paNoError) then begin - Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - // result := false; - Exit; - end; - - apiIndex := GetPreferredApiIndex(); - apiInfo := Pa_GetHostApiInfo(apiIndex); - - SC := 0; - - // init array-size to max. input-devices count - SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL - for i:= 0 to High(Recording.SoundCard) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - // current device is no input device -> skip - if(deviceInfo^.maxInputChannels <= 0) then - continue; - - // TODO: free object on termination - paSoundCard := TPortaudioSoundCard.Create(); - Recording.SoundCard[SC] := paSoundCard; - - // retrieve device-name - deviceName := deviceInfo^.name; - paSoundCard.Description := deviceName; - paSoundCard.DeviceIndex := deviceIndex; - - // setup desired input parameters - with inputParams do begin - device := deviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - // check if device supports our input-format - err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); - if(err <> 0) then begin - // format not supported -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' - + '('+ errMsg +')'); - paSoundCard.Free(); - continue; - end; - - // TODO: retry with mono if stereo is not supported - // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might - // not be set correctly in OSS) - - err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); - if(err <> paNoError) then begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' - + '('+ errMsg +')'); - paSoundCard.Free(); - continue; - end; - - - {$IFDEF UsePortmixer} - - // use default mixer - mixer := Px_OpenMixer(stream, 0); - - // get input count - inputCnt := Px_GetNumInputSources(mixer); - SetLength(paSoundCard.Input, inputCnt); - - // get input names - for SCI := 0 to inputCnt-1 do - begin - inputName := Px_GetInputSourceName(mixer, SCI); - paSoundCard.Input[SCI].Name := inputName; - end; - - Px_CloseMixer(mixer); - - {$ELSE} // !UsePortmixer - - //Pa_StartStream(stream); - // TODO: check if callback was called (this problem may occur on some devices) - //Pa_StopStream(stream); - - Pa_CloseStream(stream); - - // create a standard input source - SetLength(paSoundCard.Input, 1); - paSoundCard.Input[0].Name := 'Standard'; - - {$ENDIF} - - // use default input source - paSoundCard.InputSelected := 0; - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(Recording.SoundCard, SC); - - Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); - - { - SoundCard[SC].InputSelected := Mic[Device]; - } -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_Portaudio.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_Portaudio.CaptureStop; -var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); - end; - -end; - -{* - * Portaudio input capture callback. - *} -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); - result := paContinue; -end; - -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudio_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: TPaError; - ErrorMsg: string; - inputParams: TPaStreamParameters; - deviceInfo: PPaDeviceInfo; - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - Log.LogStatus('Cap1', 'Portaudio'); - - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); - paSoundCard.CaptureSoundLeft := CaptureSoundLeft; - paSoundCard.CaptureSoundRight := CaptureSoundRight; - - // get input latency info - deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); - - // set input stream parameters - with inputParams do begin - device := paSoundCard.DeviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); - Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); - - // open input stream - Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, - @MicrophoneCallback, Pointer(paSoundCard)); - if(Error <> paNoError) then begin - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); - //Halt; - end; - - paSoundCard.RecordStream := stream; - - // start capture - Error := Pa_StartStream(stream); - if(Error <> paNoError) then begin - Pa_CloseStream(stream); - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); - //Halt; - end; - - //Readln; - Log.LogStatus('Cap2', 'Portaudio'); -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - *} -procedure TAudio_Portaudio.StopCard(Card: byte); -var - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); - stream := paSoundCard.RecordStream; - if(stream <> nil) then begin - Pa_StopStream(stream); - Pa_CloseStream(stream); - end; -end; - - -initialization - singleton_MusicPortaudio := TAudio_Portaudio.create(); - writeln( 'UAudio_Portaudio - Register' ); - AudioManager.add( singleton_MusicPortaudio ); - -finalization - writeln( 'UAudio_Portaudio - UnRegister' ); - AudioManager.Remove( singleton_MusicPortaudio ); - -end. +unit UAudio_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + portaudio, + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; +{ +type + TPaHostApiIndex = PaHostApiIndex; + TPaDeviceIndex = PaDeviceIndex; + PPaStream = ^PaStreamPtr; + PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; + TPaStreamCallbackFlags = PaStreamCallbackFlags; + TPaHostApiTypeId = PaHostApiTypeId; + PPaHostApiInfo = ^PaHostApiInfo; + PPaDeviceInfo = ^PaDeviceInfo; + TPaError = PaError; + TPaStreamParameters = PaStreamParameters; +} +type + TAudio_Portaudio = class( TInterfacedObject, IAudioInput ) + private + function GetPreferredApiIndex(): TPaHostApiIndex; + public + function GetName: String; + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + end; + + TPortaudioSoundCard = class(TGenericSoundCard) + RecordStream: PPaStream; + DeviceIndex: TPaDeviceIndex; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +var + singleton_MusicPortaudio : IAudioInput; + +const + sampleRate: Double = 44100.; + +{* the default API used by Portaudio is the least common denominator + * and might lack efficiency. ApiPreferenceOrder defines the order of + * preferred APIs to use. The first API-type in the list is tried first. If it's + * not available the next is tried, ... + * If none of the preferred APIs was found the default API is used. + * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi + * as an array's only member if you do not have any preferences. + * paDefaultApi also terminates a preferences list but this is optional. + *} +const + paDefaultApi = -1; +var + ApiPreferenceOrder: +{$IF Defined(WIN32)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME + //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note1: Portmixer has no mixer support for paJACK at the moment + // Note2: Not tested, but ALSA might be better than OSS. + array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); +{$ELSEIF Defined(DARWIN)} + // Note: Not tested. + //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + +function TAudio_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudio_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; +begin + result := -1; + + // select preferred sound-API + for i:= 0 to High(ApiPreferenceOrder) do + begin + if(ApiPreferenceOrder[i] <> paDefaultApi) then begin + // check if API is available + result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(result >= 0) then + break; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then begin + result := Pa_GetDefaultHostApi(); + end; +end; + +// TODO: should be a function with boolean return type +procedure TAudio_Portaudio.InitializeRecord; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + inputCnt: integer; + inputName: string; + SC: integer; // soundcard + SCI: integer; // soundcard input + err: TPaError; + errMsg: string; + paSoundCard: TPortaudioSoundCard; + inputParams: TPaStreamParameters; + stream: PPaStream; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + {$ENDIF} +begin + // TODO: call Pa_Terminate() on termination + err := Pa_Initialize(); + if(err <> paNoError) then begin + Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + // result := false; + Exit; + end; + + apiIndex := GetPreferredApiIndex(); + apiInfo := Pa_GetHostApiInfo(apiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL + for i:= 0 to High(Recording.SoundCard) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + // current device is no input device -> skip + if(deviceInfo^.maxInputChannels <= 0) then + continue; + + // TODO: free object on termination + paSoundCard := TPortaudioSoundCard.Create(); + Recording.SoundCard[SC] := paSoundCard; + + // retrieve device-name + deviceName := deviceInfo^.name; + paSoundCard.Description := deviceName; + paSoundCard.DeviceIndex := deviceIndex; + + // setup desired input parameters + with inputParams do begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // check if device supports our input-format + err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); + if(err <> 0) then begin + // format not supported -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + // TODO: retry with mono if stereo is not supported + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + + err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); + if(err <> paNoError) then begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + + {$IFDEF UsePortmixer} + + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + inputCnt := Px_GetNumInputSources(mixer); + SetLength(paSoundCard.Input, inputCnt); + + // get input names + for SCI := 0 to inputCnt-1 do + begin + inputName := Px_GetInputSourceName(mixer, SCI); + paSoundCard.Input[SCI].Name := inputName; + end; + + Px_CloseMixer(mixer); + + {$ELSE} // !UsePortmixer + + //Pa_StartStream(stream); + // TODO: check if callback was called (this problem may occur on some devices) + //Pa_StopStream(stream); + + Pa_CloseStream(stream); + + // create a standard input source + SetLength(paSoundCard.Input, 1); + paSoundCard.Input[0].Name := 'Standard'; + + {$ENDIF} + + // use default input source + paSoundCard.InputSelected := 0; + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(Recording.SoundCard, SC); + + Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); + + { + SoundCard[SC].InputSelected := Mic[Device]; + } +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_Portaudio.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_Portaudio.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Portaudio input capture callback. + *} +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); + result := paContinue; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudio_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: TPaError; + ErrorMsg: string; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + paSoundCard.CaptureSoundLeft := CaptureSoundLeft; + paSoundCard.CaptureSoundRight := CaptureSoundRight; + + // get input latency info + deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); + + // set input stream parameters + with inputParams do begin + device := paSoundCard.DeviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); + Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(paSoundCard)); + if(Error <> paNoError) then begin + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); + //Halt; + end; + + paSoundCard.RecordStream := stream; + + // start capture + Error := Pa_StartStream(stream); + if(Error <> paNoError) then begin + Pa_CloseStream(stream); + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); + //Halt; + end; +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudio_Portaudio.StopCard(Card: byte); +var + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + stream := paSoundCard.RecordStream; + if(stream <> nil) then begin + Pa_StopStream(stream); + Pa_CloseStream(stream); + end; +end; + + +initialization + singleton_MusicPortaudio := TAudio_Portaudio.create(); + writeln( 'UAudio_Portaudio - Register' ); + AudioManager.add( singleton_MusicPortaudio ); + +finalization + writeln( 'UAudio_Portaudio - UnRegister' ); + AudioManager.Remove( singleton_MusicPortaudio ); + +end. diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 4fc39d4e..12268a55 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -165,7 +165,9 @@ begin end; function Tmedia_dummy.GetFFTData: TFFTData; +var data: TFFTData; begin + result := data; end; function Tmedia_dummy.GetPCMData(var data: TPCMData): Cardinal; diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index fc5eacbf..fa737d81 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -97,7 +97,6 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - end; function TVideoPlayback_ProjectM.GetName: String; @@ -180,19 +179,12 @@ begin New(pm); projectM_reset(pm); - writeln('Render Target'); - writeln( inttostr( integer( assigned(pm^.renderTarget) ) ) ); - pm^.fullscreen := 0; - pm^.gx := gx; - pm^.gy := gy; + pm^.renderTarget^.texsize := texsize; + pm^.gx := gx; + pm^.gy := gy; pm^.fps := fps; - - if assigned(pm^.renderTarget) then - begin - pm^.renderTarget^.texsize := texsize; - pm^.renderTarget^.usePbuffers := 0; - end; + pm^.renderTarget^.usePbuffers := 0; pm^.fontURL := PChar(projectM_Dir+'/fonts'); pm^.presetURL := PChar(projectM_Dir+'/presets'); @@ -240,7 +232,7 @@ begin // get audio data nSamples := AudioPlayback.GetPCMData(PcmData); - addPCM16Data(PSmallInt(@PcmData), nSamples); + addPCM16Data(PPCM16Data(@PcmData), nSamples); // store OpenGL state (might be messed up otherwise) glPushAttrib(GL_ALL_ATTRIB_BITS); -- cgit v1.2.3 From bd04e1c76d7139287be2244d03f2b62c9d117c0a Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 7 Dec 2007 03:52:07 +0000 Subject: getpcmdata creates fake pcm-data now git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@696 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMedia_dummy.pas | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 12268a55..a5cc4b5a 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -22,6 +22,7 @@ implementation uses SysUtils, + math, UMusic; @@ -170,9 +171,37 @@ begin result := data; end; +var count: integer = 0; + function Tmedia_dummy.GetPCMData(var data: TPCMData): Cardinal; -begin - result := 0; +var i: integer; +begin + // Produce some fake PCM data + if ( count mod 500 = 0 ) then + begin + for i := 0 to 511 do begin + data[0][i] := 0; + data[1][i] := 0; + end; + end + else begin + for i := 0 to 511 do begin + if ( i mod 2 = 0 ) then begin + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end + else begin; + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end; + if ( i mod 2 = 1 ) then begin + data[0][i] := -data[0][i]; + data[1][i] := -data[1][i]; + end; + end; + end; + Inc(count); + result := 512; end; // IAudioPlayback -- cgit v1.2.3 From 425ff834dbc3933475ee8f783eea6167e92ec174 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Fri, 7 Dec 2007 04:32:38 +0000 Subject: little bit of tidy up.. added command line switch, to see what media interfaces are being used. moved RandomPCM Data generation to Visualizer class. added Visualization preset change, on new line ( may be a little to much... maybe we should do ever 4 or 16 bars or something ?) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@697 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_bass.pas | 1364 ++++++++++++++++---------------- Game/Code/Classes/UAudio_portaudio.pas | 2 - Game/Code/Classes/UCommandLine.pas | 622 ++++++++------- Game/Code/Classes/UMain.pas | 5 +- Game/Code/Classes/UMedia_dummy.pas | 37 +- Game/Code/Classes/UMusic.pas | 58 +- Game/Code/Classes/UVideo.pas | 18 +- Game/Code/Classes/UVisualizer.pas | 55 +- 8 files changed, 1089 insertions(+), 1072 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 69278cca..a7bace06 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -1,685 +1,679 @@ -unit UAudio_bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - bass, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -type -{$IFDEF UseBASSInput} - TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput) -{$ELSE} - TAudio_bass = class( TInterfacedObject, IAudioPlayback) -{$ENDIF} - private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - public - Bass: hStream; - function GetName: String; - - {IAudioOutput interface} - - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - - {IAudioInput interface} - {$IFDEF UseBASSInput} - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); - {$ENDIF} - end; - -{$IFDEF UseBASSInput} - TBassSoundCard = class(TGenericSoundCard) - RecordStream: HSTREAM; - end; -{$ENDIF} - - -var - singleton_MusicBass : IAudioPlayback; - -function TAudio_bass.GetName: String; -begin - result := 'BASS'; -end; - -procedure TAudio_bass.InitializePlayback; -var - Pet: integer; - S: integer; -begin - writeln( 'TAudio_bass.InitializePlayback' ); -// Log.BenchmarkStart(4); -// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - writeln( 'TAudio_bass BASS_Init' ); - if not BASS_Init(1, 44100, 0, 0, nil) then - begin - Log.LogError('Could not initialize BASS', 'Error'); - Exit; - end; - -// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - -// Log.LogStatus('Loading Sounds', 'Music Initialize'); - - writeln( 'TAudio_bass LoadSoundFromFile' ); -// Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); - -// Log.BenchmarkEnd(4); -// Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TAudio_bass.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -end; - -procedure TAudio_bass.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TAudio_bass.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_bass.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_bass.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TAudio_bass.MoveTo(Time: real); -var - bytes: integer; -begin - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TAudio_bass.Play; -begin - if Loaded then - begin - if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing - end; -end; - -procedure TAudio_bass.Pause; //Pause Mod -begin - if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song - end; -end; - -procedure TAudio_bass.Stop; -begin - Bass_ChannelStop(Bass); -end; - -procedure TAudio_bass.Close; -begin - Bass_StreamFree(Bass); -end; - -function TAudio_bass.Length: real; -var - bytes: integer; -begin - Result := 60; - - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); -end; - -function TAudio_bass.getPosition: real; -var - bytes: integer; -begin - Result := 0; - - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -end; - -function TAudio_bass.Finished: boolean; -begin - Result := false; - - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -end; - -procedure TAudio_bass.PlayStart; -begin - BASS_ChannelPlay(BassStart, True); -end; - -procedure TAudio_bass.PlayBack; -begin - BASS_ChannelPlay(BassBack, True);// then -end; - -procedure TAudio_bass.PlaySwoosh; -begin - BASS_ChannelPlay(BassSwoosh, True); -end; - -procedure TAudio_bass.PlayChange; -begin - BASS_ChannelPlay(BassChange, True); -end; - -procedure TAudio_bass.PlayOption; -begin - BASS_ChannelPlay(BassOption, True); -end; - -procedure TAudio_bass.PlayClick; -begin - BASS_ChannelPlay(BassClick, True); -end; - -procedure TAudio_bass.PlayDrum; -begin - BASS_ChannelPlay(BassDrum, True); -end; - -procedure TAudio_bass.PlayHihat; -begin - BASS_ChannelPlay(BassHihat, True); -end; - -procedure TAudio_bass.PlayClap; -begin - BASS_ChannelPlay(BassClap, True); -end; - -procedure TAudio_bass.PlayShuffle; -begin - BASS_ChannelPlay(BassShuffle, True); -end; - -procedure TAudio_bass.StopShuffle; -begin - BASS_ChannelStop(BassShuffle); -end; - -function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end - else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TAudio_bass.GetFFTData: TFFTData; -var - Data: TFFTData; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); -end; - -{* - * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. - * Returns the number of frames (= stereo/mono sample) - *} -function TAudio_bass.GetPCMData(var data: TPCMData): Cardinal; -var - info: BASS_CHANNELINFO; - nBytes: DWORD; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetInfo(Bass, info); - ZeroMemory(@data, sizeof(TPCMData)); - - if (info.chans = 1) then - begin - // mono file -> add stereo channel - { - nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); - // interleave data - //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); - } - result := 0; - end - else - begin - // stereo file - nBytes := BASS_ChannelGetData(Bass, @data, sizeof(TPCMData)); - end; - if(nBytes <= 0) then - result := 0 - else - result := nBytes div sizeof(TPCMStereoSample); -end; - -function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); -end; - -{$IFDEF UseBASSInput} - -procedure TAudio_bass.InitializeRecord; -var - device: integer; - Descr: string; - input: integer; - input2: integer; - InputName: PChar; - Flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input - No: integer; - -function isDuplicate(Desc: String): Boolean; -var - I: Integer; -begin - Result := False; - //Check for Soundcard with same Description - For I := 0 to SC-1 do - begin - if (Recording.SoundCard[I].Description = Desc) then - begin - Result := True; - Break; - end; - end; -end; - -begin - with Recording do - begin - // checks for recording devices and puts them into an array - SetLength(SoundCard, 0); - - SC := 0; - Descr := BASS_RecordGetDeviceDescription(SC); - - while (Descr <> '') do - begin - //If there is another SoundCard with the Same ID, Search an available Name - if (IsDuplicate(Descr)) then - begin - No:= 1; //Count of SoundCards with same Name - Repeat - Inc(No) - Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - - //Set Description - Descr := Descr + ' (' + InttoStr(No) + ')'; - end; - - SetLength(SoundCard, SC+1); - - // TODO: free object on termination - SoundCard[SC] := TBassSoundCard.Create(); - SoundCard[SC].Description := Descr; - - //Get Recording Inputs - SCI := 0; - BASS_RecordInit(SC); - - InputName := BASS_RecordGetInputName(SCI); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty - // InputName. So, we have to add a hard coded - // Workaround for this problem - if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then - begin - InputName := 'Microphone'; - end; - {$ENDIF} - - SetLength(SoundCard[SC].Input, 1); - SoundCard[SC].Input[SCI].Name := InputName; - - // process each input - while (InputName <> nil) do - begin - Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then - begin - SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; - end; - - //Set Mic Index - if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then - SoundCard[SC].MicInput := SCI; - - Inc(SCI); - InputName := BASS_RecordGetInputName(SCI); - end; - - BASS_RecordFree; - - Inc(SC); - Descr := BASS_RecordGetDeviceDescription(SC); - end; // while - end; // with Recording -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_bass.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_bass.CaptureStop; -var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); - end; - -end; - -{* - * Bass input capture callback. - * Params: - * stream - BASS input stream - * buffer - buffer of captured samples - * len - size of buffer in bytes - * user - players associated with left/right channels - *} -function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; - len: Cardinal; Card: Cardinal): boolean; stdcall; -begin - Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); - Result := true; -end; - -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudio_bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: integer; - ErrorMsg: string; - bassSoundCard: TBassSoundCard; -begin - if not BASS_RecordInit(Card) then - begin - Error := BASS_ErrorGetCode; - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); - Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); - end - else - begin - bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); - bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; - bassSoundCard.CaptureSoundRight := CaptureSoundRight; - - // capture in 44.1kHz/stereo/16bit and a 20ms callback period - bassSoundCard.RecordStream := - BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); - end; -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - *} -procedure TAudio_bass.StopCard(Card: byte); -begin - BASS_RecordSetDevice(Card); - BASS_RecordFree; -end; - -{$ENDIF} - - -initialization - singleton_MusicBass := TAudio_bass.create(); - - writeln( 'UAudio_Bass - Register' ); - AudioManager.add( singleton_MusicBass ); - -finalization - writeln( 'UAudio_Bass - UnRegister' ); - AudioManager.Remove( singleton_MusicBass ); - -end. +unit UAudio_bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +type +{$IFDEF UseBASSInput} + TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput) +{$ELSE} + TAudio_bass = class( TInterfacedObject, IAudioPlayback) +{$ENDIF} + private + BassStart: hStream; // Wait, I've replaced this with BASS + BassBack: hStream; // It has almost all features we need + BassSwoosh: hStream; + BassChange: hStream; // Almost? It aleady has them all :) + BassOption: hStream; + BassClick: hStream; + BassDrum: hStream; + BassHihat: hStream; + BassClap: hStream; + BassShuffle: hStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + + public + Bass: hStream; + function GetName: String; + + {IAudioOutput interface} + + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function getPosition: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + + {IAudioInput interface} + {$IFDEF UseBASSInput} + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + {$ENDIF} + end; + +{$IFDEF UseBASSInput} + TBassSoundCard = class(TGenericSoundCard) + RecordStream: HSTREAM; + end; +{$ENDIF} + + +var + singleton_MusicBass : IAudioPlayback; + +function TAudio_bass.GetName: String; +begin + result := 'BASS'; +end; + +procedure TAudio_bass.InitializePlayback; +var + Pet: integer; + S: integer; +begin +// Log.BenchmarkStart(4); +// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + if not BASS_Init(1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'Error'); + Exit; + end; + +// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + +// Log.LogStatus('Loading Sounds', 'Music Initialize'); + +// Log.BenchmarkStart(4); + LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + +// Log.BenchmarkEnd(4); +// Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TAudio_bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudio_bass.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume + // TODO : jb_linux replace with something other than bass + BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_bass.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_bass.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_bass.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TAudio_bass.MoveTo(Time: real); +var + bytes: integer; +begin + bytes := BASS_ChannelSeconds2Bytes(Bass, Time); + BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_bass.Play; +begin + if Loaded then + begin + if Loop then + BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class + + BASS_ChannelPlay(Bass, False); // for setting position before playing + end; +end; + +procedure TAudio_bass.Pause; //Pause Mod +begin + if Loaded then begin + BASS_ChannelPause(Bass); // Pauses Song + end; +end; + +procedure TAudio_bass.Stop; +begin + Bass_ChannelStop(Bass); +end; + +procedure TAudio_bass.Close; +begin + Bass_StreamFree(Bass); +end; + +function TAudio_bass.Length: real; +var + bytes: integer; +begin + Result := 60; + + bytes := BASS_ChannelGetLength(Bass); + Result := BASS_ChannelBytes2Seconds(Bass, bytes); +end; + +function TAudio_bass.getPosition: real; +var + bytes: integer; +begin + Result := 0; + + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +end; + +function TAudio_bass.Finished: boolean; +begin + Result := false; + + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +end; + +procedure TAudio_bass.PlayStart; +begin + BASS_ChannelPlay(BassStart, True); +end; + +procedure TAudio_bass.PlayBack; +begin + BASS_ChannelPlay(BassBack, True);// then +end; + +procedure TAudio_bass.PlaySwoosh; +begin + BASS_ChannelPlay(BassSwoosh, True); +end; + +procedure TAudio_bass.PlayChange; +begin + BASS_ChannelPlay(BassChange, True); +end; + +procedure TAudio_bass.PlayOption; +begin + BASS_ChannelPlay(BassOption, True); +end; + +procedure TAudio_bass.PlayClick; +begin + BASS_ChannelPlay(BassClick, True); +end; + +procedure TAudio_bass.PlayDrum; +begin + BASS_ChannelPlay(BassDrum, True); +end; + +procedure TAudio_bass.PlayHihat; +begin + BASS_ChannelPlay(BassHihat, True); +end; + +procedure TAudio_bass.PlayClap; +begin + BASS_ChannelPlay(BassClap, True); +end; + +procedure TAudio_bass.PlayShuffle; +begin + BASS_ChannelPlay(BassShuffle, True); +end; + +procedure TAudio_bass.StopShuffle; +begin + BASS_ChannelStop(BassShuffle); +end; + +function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Handle := hStream; + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TAudio_bass.GetFFTData: TFFTData; +var + Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +end; + +{* + * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. + * Returns the number of frames (= stereo/mono sample) + *} +function TAudio_bass.GetPCMData(var data: TPCMData): Cardinal; +var + info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetInfo(Bass, info); + ZeroMemory(@data, sizeof(TPCMData)); + + if (info.chans = 1) then + begin + // mono file -> add stereo channel + { + nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); + // interleave data + //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); + } + result := 0; + end + else + begin + // stereo file + nBytes := BASS_ChannelGetData(Bass, @data, sizeof(TPCMData)); + end; + if(nBytes <= 0) then + result := 0 + else + result := nBytes div sizeof(TPCMStereoSample); +end; + +function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + BASS_ChannelPlay(CustomSounds[Index].Handle, True); +end; + +{$IFDEF UseBASSInput} + +procedure TAudio_bass.InitializeRecord; +var + device: integer; + Descr: string; + input: integer; + input2: integer; + InputName: PChar; + Flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input + No: integer; + +function isDuplicate(Desc: String): Boolean; +var + I: Integer; +begin + Result := False; + //Check for Soundcard with same Description + For I := 0 to SC-1 do + begin + if (Recording.SoundCard[I].Description = Desc) then + begin + Result := True; + Break; + end; + end; +end; + +begin + with Recording do + begin + // checks for recording devices and puts them into an array + SetLength(SoundCard, 0); + + SC := 0; + Descr := BASS_RecordGetDeviceDescription(SC); + + while (Descr <> '') do + begin + //If there is another SoundCard with the Same ID, Search an available Name + if (IsDuplicate(Descr)) then + begin + No:= 1; //Count of SoundCards with same Name + Repeat + Inc(No) + Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + + //Set Description + Descr := Descr + ' (' + InttoStr(No) + ')'; + end; + + SetLength(SoundCard, SC+1); + + // TODO: free object on termination + SoundCard[SC] := TBassSoundCard.Create(); + SoundCard[SC].Description := Descr; + + //Get Recording Inputs + SCI := 0; + BASS_RecordInit(SC); + + InputName := BASS_RecordGetInputName(SCI); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then + begin + InputName := 'Microphone'; + end; + {$ENDIF} + + SetLength(SoundCard[SC].Input, 1); + SoundCard[SC].Input[SCI].Name := InputName; + + // process each input + while (InputName <> nil) do + begin + Flags := BASS_RecordGetInput(SCI); + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then + begin + SetLength(SoundCard[SC].Input, SCI+1); + SoundCard[SC].Input[SCI].Name := InputName; + end; + + //Set Mic Index + if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then + SoundCard[SC].MicInput := SCI; + + Inc(SCI); + InputName := BASS_RecordGetInputName(SCI); + end; + + BASS_RecordFree; + + Inc(SC); + Descr := BASS_RecordGetDeviceDescription(SC); + end; // while + end; // with Recording +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_bass.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudio_bass.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; Card: Cardinal): boolean; stdcall; +begin + Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); + Result := true; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudio_bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: integer; + ErrorMsg: string; + bassSoundCard: TBassSoundCard; +begin + if not BASS_RecordInit(Card) then + begin + Error := BASS_ErrorGetCode; + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); + Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); + end + else + begin + bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); + bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; + bassSoundCard.CaptureSoundRight := CaptureSoundRight; + + // capture in 44.1kHz/stereo/16bit and a 20ms callback period + bassSoundCard.RecordStream := + BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); + end; +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudio_bass.StopCard(Card: byte); +begin + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + +{$ENDIF} + + +initialization + singleton_MusicBass := TAudio_bass.create(); + AudioManager.add( singleton_MusicBass ); + +finalization + AudioManager.Remove( singleton_MusicBass ); + +end. diff --git a/Game/Code/Classes/UAudio_portaudio.pas b/Game/Code/Classes/UAudio_portaudio.pas index 941d90d1..47e54981 100644 --- a/Game/Code/Classes/UAudio_portaudio.pas +++ b/Game/Code/Classes/UAudio_portaudio.pas @@ -419,11 +419,9 @@ end; initialization singleton_MusicPortaudio := TAudio_Portaudio.create(); - writeln( 'UAudio_Portaudio - Register' ); AudioManager.add( singleton_MusicPortaudio ); finalization - writeln( 'UAudio_Portaudio - UnRegister' ); AudioManager.Remove( singleton_MusicPortaudio ); end. diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 01ece795..6a5a4808 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -1,294 +1,328 @@ -unit UCommandLine; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -type - //----------- - // TCMDParams - Class Reaads Infos from ParamStr and set some easy Interface Variables - //----------- - TCMDParams = class - private - sLanguage: String; - sResolution: String; - public - //Some Boolean Variables Set when Reading Infos - Debug: Boolean; - Benchmark: Boolean; - NoLog: Boolean; - FullScreen: Boolean; - Joypad: Boolean; - - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - Depth: Integer; - Screens: Integer; - - //Some Strings Set when Reading Infos {Length=0 Not Set} - SongPath: String; - ConfigFile: String; - ScoreFile: String; - - //Pseudo Integer Values - Function GetLanguage: Integer; - Property Language: Integer read GetLanguage; - - Function GetResolution: Integer; - Property Resolution: Integer read GetResolution; - - //Some Procedures for Reading Infos - Constructor Create; - - Procedure ResetVariables; - Procedure ReadParamInfo; - end; - -var - Params: TCMDParams; - -implementation - -uses SysUtils; -// uINI -- Nasty requirement... ( removed with permission of blindy ) - - -//------------- -// Constructor - Create class, Reset Variables and Read Infos -//------------- -Constructor TCMDParams.Create; -begin - ResetVariables; - ReadParamInfo; -end; - -//------------- -// ResetVariables - Reset Class Variables -//------------- -Procedure TCMDParams.ResetVariables; -begin - Debug := False; - Benchmark := False; - NoLog := False; - FullScreen := False; - Joypad := False; - - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - sResolution := ''; - sLanguage := ''; - Depth := -1; - Screens := -1; - - //Some Strings Set when Reading Infos {Length=0 Not Set} - SongPath := ''; - ConfigFile := ''; - ScoreFile := ''; -end; - -//------------- -// ReadParamInfo - Read Infos from Parameters -//------------- -Procedure TCMDParams.ReadParamInfo; -var - I: Integer; - PCount: Integer; - Command: String; -begin - PCount := ParamCount; - //Log.LogError('ParamCount: ' + Inttostr(PCount)); - - //Check all Parameters - For I := 1 to PCount do - begin - Command := Paramstr(I); - //Log.LogError('Start parsing Command: ' + Command); - //Is String Parameter ? - if (Length(Command) > 1) AND (Command[1] = '-') then - begin - //Remove - from Command - Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); - //Log.LogError('Command prepared: ' + Command); - - //Check Command - - // Boolean Triggers: - if (Command = 'debug') then - Debug := True - else if (Command = 'benchmark') then - Benchmark := True - else if (Command = 'nolog') then - NoLog := True - else if (Command = 'fullscreen') then - Fullscreen := True - else if (Command = 'joypad') then - Joypad := True - - //Integer Variables - else if (Command = 'depth') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - //Check for valid Value - If (Command = '16') then - Depth := 0 - Else If (Command = '32') then - Depth := 1; - end; - end - - else if (Command = 'screens') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - //Check for valid Value - If (Command = '1') then - Screens := 0 - Else If (Command = '2') then - Screens := 1; - end; - end - - //Pseudo Integer Values - else if (Command = 'language') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - sLanguage := Lowercase(ParamStr(I + 1)); - end; - end - - else if (Command = 'resolution') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - sResolution := Lowercase(ParamStr(I + 1)); - end; - end - - //String Values - else if (Command = 'songpath') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - SongPath := ParamStr(I + 1); - end; - end - - else if (Command = 'configfile') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - ConfigFile := ParamStr(I + 1); - - //is this a relative PAth -> then add Gamepath - if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then - ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; - end; - end - - else if (Command = 'scorefile') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - ScoreFile := ParamStr(I + 1); - end; - end; - - end; - - end; - -{ Log.LogError('Values: '); - - if Debug then - Log.LogError('Debug'); - - if Benchmark then - Log.LogError('Benchmark'); - - if NoLog then - Log.LogError('NoLog'); - - if Fullscreen then - Log.LogError('FullScreen'); - - if JoyStick then - Log.LogError('Joystick'); - - - Log.LogError('Screens: ' + Inttostr(Screens)); - Log.LogError('Depth: ' + Inttostr(Depth)); - - Log.LogError('Resolution: ' + Inttostr(Resolution)); - Log.LogError('Resolution: ' + Inttostr(Language)); - - Log.LogError('sResolution: ' + sResolution); - Log.LogError('sLanguage: ' + sLanguage); - - Log.LogError('ConfigFile: ' + ConfigFile); - Log.LogError('SongPath: ' + SongPath); - Log.LogError('ScoreFile: ' + ScoreFile); } - -end; - -//------------- -// GetLanguage - Get Language ID from saved String Information -//------------- -Function TCMDParams.GetLanguage: Integer; -var - I: integer; -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Language - For I := 0 to high(ILanguage) do - if (LowerCase(ILanguage[I]) = sLanguage) then - begin - Result := I; - Break; - end; -*} -end; - -//------------- -// GetResolution - Get Resolution ID from saved String Information -//------------- -Function TCMDParams.GetResolution: Integer; -var - I: integer; -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Resolution - For I := 0 to high(IResolution) do - if (LowerCase(IResolution[I]) = sResolution) then - begin - Result := I; - Break; - end; -*} -end; - -end. +unit UCommandLine; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + //----------- + // TCMDParams - Class Reaads Infos from ParamStr and set some easy Interface Variables + //----------- + TCMDParams = class + private + sLanguage: String; + sResolution: String; + public + //Some Boolean Variables Set when Reading Infos + Debug: Boolean; + Benchmark: Boolean; + NoLog: Boolean; + FullScreen: Boolean; + Joypad: Boolean; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + Depth: Integer; + Screens: Integer; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath: String; + ConfigFile: String; + ScoreFile: String; + + procedure showhelp(); + + //Pseudo Integer Values + Function GetLanguage: Integer; + Property Language: Integer read GetLanguage; + + Function GetResolution: Integer; + Property Resolution: Integer read GetResolution; + + //Some Procedures for Reading Infos + Constructor Create; + + Procedure ResetVariables; + Procedure ReadParamInfo; + end; + +var + Params: TCMDParams; + +const + cHelp = 'help'; + cMediaInterfaces = 'showinterfaces'; + + +implementation + +uses SysUtils; +// uINI -- Nasty requirement... ( removed with permission of blindy ) + + +//------------- +// Constructor - Create class, Reset Variables and Read Infos +//------------- +Constructor TCMDParams.Create; +begin + + if FindCmdLineSwitch( cHelp ) then + showhelp(); + + ResetVariables; + ReadParamInfo; +end; + +procedure TCMDParams.showhelp(); + + function s( aString : String ) : string; + begin + result := aString + StringofChar( ' ', 15 - length( aString ) ); + end; + +begin + + writeln( '' ); + writeln( '**************************************************************' ); + writeln( ' UltraStar Deluxe - Command line switches ' ); + writeln( '**************************************************************' ); + writeln( '' ); + writeln( ' '+s( 'Switch' ) +' : Purpose' ); + writeln( ' ----------------------------------------------------------' ); + writeln( ' '+s( cMediaInterfaces ) + ' : Show in-use media interfaces' ); + writeln( '' ); + + halt(); +end; + +//------------- +// ResetVariables - Reset Class Variables +//------------- +Procedure TCMDParams.ResetVariables; +begin + Debug := False; + Benchmark := False; + NoLog := False; + FullScreen := False; + Joypad := False; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + sResolution := ''; + sLanguage := ''; + Depth := -1; + Screens := -1; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath := ''; + ConfigFile := ''; + ScoreFile := ''; +end; + +//------------- +// ReadParamInfo - Read Infos from Parameters +//------------- +Procedure TCMDParams.ReadParamInfo; +var + I: Integer; + PCount: Integer; + Command: String; +begin + PCount := ParamCount; + //Log.LogError('ParamCount: ' + Inttostr(PCount)); + + + //Check all Parameters + For I := 1 to PCount do + begin + Command := Paramstr(I); + //Log.LogError('Start parsing Command: ' + Command); + //Is String Parameter ? + if (Length(Command) > 1) AND (Command[1] = '-') then + begin + //Remove - from Command + Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); + //Log.LogError('Command prepared: ' + Command); + + //Check Command + + // Boolean Triggers: + if (Command = 'debug') then + Debug := True + else if (Command = 'benchmark') then + Benchmark := True + else if (Command = 'nolog') then + NoLog := True + else if (Command = 'fullscreen') then + Fullscreen := True + else if (Command = 'joypad') then + Joypad := True + + //Integer Variables + else if (Command = 'depth') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '16') then + Depth := 0 + Else If (Command = '32') then + Depth := 1; + end; + end + + else if (Command = 'screens') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '1') then + Screens := 0 + Else If (Command = '2') then + Screens := 1; + end; + end + + //Pseudo Integer Values + else if (Command = 'language') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sLanguage := Lowercase(ParamStr(I + 1)); + end; + end + + else if (Command = 'resolution') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sResolution := Lowercase(ParamStr(I + 1)); + end; + end + + //String Values + else if (Command = 'songpath') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + SongPath := ParamStr(I + 1); + end; + end + + else if (Command = 'configfile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ConfigFile := ParamStr(I + 1); + + //is this a relative PAth -> then add Gamepath + if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then + ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; + end; + end + + else if (Command = 'scorefile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ScoreFile := ParamStr(I + 1); + end; + end; + + end; + + end; + +{ Log.LogError('Values: '); + + if Debug then + Log.LogError('Debug'); + + if Benchmark then + Log.LogError('Benchmark'); + + if NoLog then + Log.LogError('NoLog'); + + if Fullscreen then + Log.LogError('FullScreen'); + + if JoyStick then + Log.LogError('Joystick'); + + + Log.LogError('Screens: ' + Inttostr(Screens)); + Log.LogError('Depth: ' + Inttostr(Depth)); + + Log.LogError('Resolution: ' + Inttostr(Resolution)); + Log.LogError('Resolution: ' + Inttostr(Language)); + + Log.LogError('sResolution: ' + sResolution); + Log.LogError('sLanguage: ' + sLanguage); + + Log.LogError('ConfigFile: ' + ConfigFile); + Log.LogError('SongPath: ' + SongPath); + Log.LogError('ScoreFile: ' + ScoreFile); } + +end; + +//------------- +// GetLanguage - Get Language ID from saved String Information +//------------- +Function TCMDParams.GetLanguage: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Language + For I := 0 to high(ILanguage) do + if (LowerCase(ILanguage[I]) = sLanguage) then + begin + Result := I; + Break; + end; +*} +end; + +//------------- +// GetResolution - Get Resolution ID from saved String Information +//------------- +Function TCMDParams.GetResolution: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Resolution + For I := 0 to high(IResolution) do + if (LowerCase(IResolution[I]) = sResolution) then + begin + Result := I; + Break; + end; +*} +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 67ec2ea8..b97408d4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -120,7 +120,10 @@ procedure ClearScores(PlayerNum: integer); implementation -uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, +uses USongs, + UJoystick, + math, + UCommandLine, ULanguage, SDL_ttf, USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index a5cc4b5a..697dc2f9 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -171,37 +171,9 @@ begin result := data; end; -var count: integer = 0; - function Tmedia_dummy.GetPCMData(var data: TPCMData): Cardinal; -var i: integer; -begin - // Produce some fake PCM data - if ( count mod 500 = 0 ) then - begin - for i := 0 to 511 do begin - data[0][i] := 0; - data[1][i] := 0; - end; - end - else begin - for i := 0 to 511 do begin - if ( i mod 2 = 0 ) then begin - data[0][i] := floor(Random * power(2.,14)); - data[1][i] := floor(Random * power(2.,14)); - end - else begin; - data[0][i] := floor(Random * power(2.,14)); - data[1][i] := floor(Random * power(2.,14)); - end; - if ( i mod 2 = 1 ) then begin - data[0][i] := -data[0][i]; - data[1][i] := -data[1][i]; - end; - end; - end; - Inc(count); - result := 512; +begin + result := 0; end; // IAudioPlayback @@ -293,16 +265,11 @@ procedure Tmedia_dummy.PlayCustomSound(const Index: Cardinal ); begin end; - - initialization singleton_dummy := Tmedia_dummy.create(); - - writeln( 'UMedia_dummy - Register' ); AudioManager.add( singleton_dummy ); finalization - writeln( 'UMedia_dummy - UnRegister' ); AudioManager.Remove( singleton_dummy ); end. diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 2cdcc707..7e1aa839 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -109,21 +109,12 @@ type procedure MoveTo(Time: real); function getPosition: real; - - property position : real READ getPosition WRITE MoveTo; + + property position : real READ getPosition WRITE MoveTo; end; IVideoPlayback = Interface( IGenericPlayback ) ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] -(* - procedure FFmpegOpenFile(FileName: pAnsiChar); - procedure FFmpegClose; - - procedure FFmpegGetFrame(Time: Extended); - procedure FFmpegDrawGL(Screen: integer); - procedure FFmpegTogglePause; - procedure FFmpegSkip(Time: Single); -*) procedure init(); procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC @@ -141,16 +132,10 @@ type procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); -// function Open(Name: string): boolean; // true if succeed + procedure Rewind; -// procedure MoveTo(Time: real); -// procedure Play; -// procedure Pause; -// procedure Stop; -// procedure Close; - function Finished: boolean; - function Length: real; -// function getPosition: real; + function Finished: boolean; + function Length: real; procedure PlayStart; procedure PlayBack; @@ -211,7 +196,8 @@ function AudioManager: TInterfaceList; implementation uses - sysutils; + sysutils, + UCommandLine; // uLog; var @@ -264,7 +250,6 @@ begin singleton_VideoPlayback := nil; singleton_Visualization := nil; - writeln( 'InitializeSound , Enumerate Registered Audio Interfaces' ); for iCount := 0 to AudioManager.Count - 1 do begin if assigned( AudioManager[iCount] ) then @@ -273,7 +258,6 @@ begin if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND ( true ) then -// ( not assigned( singleton_AudioPlayback ) ) then begin singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); end; @@ -281,17 +265,13 @@ begin // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND ( true ) then -// ( not assigned( singleton_AudioInput ) ) then begin singleton_AudioInput := IAudioInput( lTmpInterface ); - Writeln(singleton_AudioInput.GetName); end; // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND - //( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) <> 0 ) AND ( true ) then -// ( not assigned( singleton_VideoPlayback ) ) then begin singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); end; @@ -306,38 +286,44 @@ begin end; + if VideoPlayback <> nil then begin - writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); end; if AudioPlayback <> nil then begin - writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); - // Log.LogStatus('Initializing Playback ('+AudioPlayback.GetName+')', 'InitializeSound'); AudioPlayback.InitializePlayback; end; if AudioInput <> nil then begin - writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); - -// Log.LogStatus('Initializing Record ('+AudioPlayback.GetName+')', 'InitializeSound'); AudioInput.InitializeRecord; end; - writeln( 'InitializeSound DONE' ); + if FindCmdLineSwitch( cMediaInterfaces ) then + begin + writeln( '' ); + writeln( '--------------------------------------------------------------' ); + writeln( ' In-use Media Interfaces ' ); + writeln( '--------------------------------------------------------------' ); + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); + writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); + writeln( '--------------------------------------------------------------' ); + writeln( '' ); + halt; + end; end; initialization begin - writeln('Init AudioManager'); singleton_AudioManager := TInterfaceList.Create(); end; finalization - writeln('Finalize AudioManager'); singleton_AudioManager.clear; FreeAndNil( singleton_AudioManager ); diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 62351e2d..644c62a8 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -161,7 +161,7 @@ begin writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) ); writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) ); - + i := 0; while ( i < aFormatCtx.nb_streams ) do // while ( i < length(aFormatCtx.streams)-1 ) do @@ -415,22 +415,15 @@ end; constructor TVideoPlayback_ffmpeg.create(); begin - writeln( 'UVideo_FFMpeg - TVideoPlayback_ffmpeg.create()' ); - - writeln( 'UVideo_FFMpeg - av_register_all' ); av_register_all; fVideoOpened := False; fVideoPaused := False; - end; procedure TVideoPlayback_ffmpeg.init(); begin - writeln( 'UVideo_FFMpeg - glGenTextures(1, PglUint(@fVideoTex))' ); glGenTextures(1, PglUint(@fVideoTex)); - - writeln( 'UVideo_FFMpeg - SetLength(fTexData,0)' ); SetLength(fTexData,0); end; @@ -453,10 +446,10 @@ begin TimeDifference := 0; VideoFormatContext := 0; - writeln( aFileName ); - +// writeln( aFileName ); + errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil); - writeln( 'Errnum : ' +inttostr( errnum )); +// writeln( 'Errnum : ' +inttostr( errnum )); if(errnum <> 0) then begin {$ifdef DebugDisplay} @@ -684,11 +677,8 @@ end; initialization singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); - - writeln( 'UVideo_FFMpeg - Register Playback' ); AudioManager.add( singleton_VideoFFMpeg ); - finalization AudioManager.Remove( singleton_VideoFFMpeg ); diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index fa737d81..6548e2b7 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -56,10 +56,14 @@ type hRC : Integer; hDC : Integer; + RndPCMcount : integer; + procedure VisualizerStart; procedure VisualizerStop; procedure VisualizerTogglePause; + + function GetRandomPCMData(var data: TPCMData): Cardinal; public constructor create(); procedure init(); @@ -82,13 +86,12 @@ type constructor TVideoPlayback_ProjectM.create(); begin + RndPCMcount := 0; end; procedure TVideoPlayback_ProjectM.init(); begin - writeln( 'TVideoPlayback_ProjectM - INITIALIZE !!!!!!!!' ); - VisualizerStarted := False; VisualizerPaused := False; @@ -232,6 +235,10 @@ begin // get audio data nSamples := AudioPlayback.GetPCMData(PcmData); + + if nSamples = 0 then + nSamples := GetRandomPCMData(PcmData); + addPCM16Data(PPCM16Data(@PcmData), nSamples); // store OpenGL state (might be messed up otherwise) @@ -244,7 +251,15 @@ begin glPushMatrix(); // let projectM render a frame - renderFrame(pm); + try + renderFrame(pm); + except + // This happens with some presets... ( and only some times also .. moreso on linux ) + // if we have an "Invalid Floating Point Error" while rendering a frame... then change preset. + MoveTo( now ); + + // hmm have to be careful, that we dont get to many here... coz it could keep failing.. and trying again. + end; glFlush(); {$IFDEF UseTexture} @@ -323,11 +338,41 @@ begin {$ENDIF} end; +function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; +var + i: integer; +begin + // Produce some fake PCM data + if ( RndPCMcount mod 500 = 0 ) then + begin + for i := 0 to 511 do begin + data[0][i] := 0; + data[1][i] := 0; + end; + end + else begin + for i := 0 to 511 do begin + if ( i mod 2 = 0 ) then begin + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end + else begin; + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end; + if ( i mod 2 = 1 ) then begin + data[0][i] := -data[0][i]; + data[1][i] := -data[1][i]; + end; + end; + end; + Inc( RndPCMcount ); + result := 512; +end; + initialization singleton_VideoProjectM := TVideoPlayback_ProjectM.create(); - - writeln( 'UVideoProjectM - Register Playback' ); AudioManager.add( singleton_VideoProjectM ); finalization -- cgit v1.2.3 From 10e4f765a5953f3644055d6628531855e9a30df6 Mon Sep 17 00:00:00 2001 From: b1indy Date: Wed, 12 Dec 2007 15:46:07 +0000 Subject: got back those nice stars ;) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@698 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index c3b042ea..f774a899 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -295,8 +295,8 @@ begin Log.LogStatus('Loading Textures - B', 'LoadTextures'); - Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'JPG', 'Font Black', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'JPG', 'Alpha Black Colored', $FFFFFF); + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF); Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); -- cgit v1.2.3 From 8cc30e0a1603053ea7f4830187a47f958d6c5a4b Mon Sep 17 00:00:00 2001 From: b1indy Date: Wed, 12 Dec 2007 16:56:17 +0000 Subject: some "progress" with the lyrics don't understand, why my debug display and what's shown in thy lyric-bar doesn't match (as i see it in the code, it should be the same) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@700 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 8eaa2a5f..70031ef0 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -342,7 +342,7 @@ begin //Create LyricTexture //Prepare Ogl glGetIntegerv(GL_VIEWPORT, @ViewPort); - glClearColor(0.0,0.0,0.0,0); + glClearColor(0.0,0.0,0.0,0.0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); {glMatrixMode(GL_PROJECTION); glLoadIdentity; @@ -356,9 +356,10 @@ begin Display.ScreenShot; //Copy to Texture + glEnable(GL_ALPHA); glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 448, 512, 64, 0); - + glDisable(GL_ALPHA); //Clear Buffer glClearColor(0,0,0,0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); @@ -383,10 +384,10 @@ Procedure TLyricEngine.Draw (Beat: Real); begin DrawLyrics(Beat); - +/////// start of debug draw glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_Alpha {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_Alpha); + glBlendFunc(GL_SRC_Alpha, GL_ONE_MINUS_SRC_Alpha); glBindTexture(GL_TEXTURE_2D, PUpperLine^.Tex); glColor4f(1,1,0,1); @@ -409,7 +410,7 @@ begin glDisable(GL_BLEND); glDisable(GL_TEXTURE_2D); - +/////// end of debug draw end; //--------------- @@ -500,7 +501,7 @@ begin //Draw complete Sentence glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); - glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}, GL_ONE_MINUS_SRC_COLOR); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, Line.Tex); glColorRGB(LineColor_en); @@ -517,6 +518,29 @@ begin end else begin + //Get Start Position: + { Start of Line - Width of all Icons + LineWidth/2 (Center} + LyricX := X + {(W - ((IconSize + 1) * 6))/2 +} ((IconSize + 1) * 3); + + LyricX2 := LyricX +500{ Line.Width}; + + //Draw complete Sentence + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_akt); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); + glTexCoord2f(1, 0); glVertex2f(LyricX2, Y + 64 * W / 512); + glTexCoord2f(1, 1); glVertex2f(LyricX2, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); end; -- cgit v1.2.3 From 3fee8809240ec65ea6bf3e8a143fd88b31550f11 Mon Sep 17 00:00:00 2001 From: mogguh Date: Wed, 12 Dec 2007 19:28:09 +0000 Subject: Some tweaking on the lyrics, credits to blindy! :X git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@701 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 70031ef0..2d826547 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -59,7 +59,7 @@ type //Some helper Procedures for Lyric Drawing procedure DrawLyrics (Beat: Real); - procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; 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); public //Positions, Line specific Settings @@ -418,8 +418,8 @@ end; //--------------- procedure TLyricEngine.DrawLyrics (Beat: Real); begin - DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); + DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, PUpperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, PLowerline, Beat); end; //--------------- @@ -453,7 +453,7 @@ end; //--------------- // DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine //--------------- -procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: TLyricLine; Beat: Real); +procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); var I: Integer; CurWord: Integer; @@ -490,19 +490,19 @@ begin DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} //Check if a Word in the Sentence is active - if ((Line.Start > Beat) AND (Line.Start + Line.Length < Beat)) then + if ((Line^.Start > Beat) AND (Line^.Start + Line^.Length < Beat)) then begin //Get Start Position: { Start of Line - Width of all Icons + LineWidth/2 (Center} LyricX := X + (W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3); - LyricX2 := LyricX + Line.Width; + LyricX2 := LyricX + Line^.Width; //Draw complete Sentence glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Line.Tex); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); glColorRGB(LineColor_en); glBegin(GL_QUADS); @@ -528,7 +528,7 @@ begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Line.Tex); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); glColorRGB(LineColor_akt); glBegin(GL_QUADS); -- cgit v1.2.3 From 5404b0734c15320423bc4848fbc0880ed092e5e7 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 15 Dec 2007 17:12:20 +0000 Subject: again some progress with the lyrics... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@703 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 254 +++++++++++++++++++++++++++++++----------- 1 file changed, 189 insertions(+), 65 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 2d826547..8bbb2db3 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -33,6 +33,7 @@ type Width: Real; //Width of the Lyricline in Tex Size: Byte; //Size of the Font in the Texture Words: ALyricWord; //Words from this Line + CurWord: Integer; //current active word (only valid if line is active) Start: Cardinal; //Start in Quarters of teh Line Length: Cardinal; //Length in Quarters (From Start of First Note to the End of Last Note) Freestyle: Boolean; //Complete Line is Freestyle ? @@ -76,7 +77,7 @@ type //Display Propertys LineColor_en: TRGBA; //Color of Words in an Enabled Line LineColor_dis: TRGBA; //Color of Words in a Disabled Line - LineColor_akt: TRGBA; //Color of teh active Word + 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 @@ -206,7 +207,7 @@ var function CreateLineTex: glUint; begin - GetMem(pTexData, 1024*128*4); //get Memory to save Tex in + GetMem(pTexData, 1024*64*4); //get Memory to save Tex in //generate and bind Texture glGenTextures(1, @Result); @@ -278,7 +279,7 @@ begin end; end else - begin + begin // rotate lines (round-robin-like) LyricLine:=PUpperLine; PUpperLine:=PLowerLine; PLowerLine:=PQueueLine; @@ -295,6 +296,7 @@ begin LyricLine.Freestyle := True; //is set by And Notes Freestyle while copying Notes LyricLine.Text := ''; //Also Set while copying Notes LyricLine.Players := 127; //All Players for now, no Duett Mode available + LyricLine.CurWord:=-1; // inactive line - so no word active atm //Copy Words SetLength(LyricLine.Words, CountNotes + 1); For I := 0 to CountNotes do @@ -316,7 +318,8 @@ begin glColor4f(1, 1, 1, 1); //Change Fontsize to Fit the Screen - While (LyricLine.Width > 508) do + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + While (LyricLine.Width > UpperLineW) do begin Dec(LyricLine.Size); @@ -328,13 +331,13 @@ begin end; //Set Word Positions and Line Size - PosX := 2 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; + PosX := 0 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; For I := 0 to High(LyricLine.Words) do begin LyricLine.Words[I].X := PosX; LyricLine.Words[I].Width := glTextWidth(PChar(LyricLine.Words[I].Text)); - LyricLine.Words[I].TexPos := PosX / 512; - LyricLine.Words[I].TexWidth := LyricLine.Words[I].TexWidth / 512; + LyricLine.Words[I].TexPos := (PosX+1) / 1024; + LyricLine.Words[I].TexWidth := (LyricLine.Words[I].Width-1) / 1024; PosX := PosX + LyricLine.Words[I].Width; end; @@ -348,7 +351,7 @@ begin glLoadIdentity; glOrtho(0, 1024, 64, 0, -1, 100); glMatrixMode(GL_MODELVIEW);} - glViewport(0, 0, 512, 512); + glViewPort(0,0,800,600); //Draw Lyrics SetFontPos(0, 0); @@ -358,7 +361,7 @@ begin //Copy to Texture glEnable(GL_ALPHA); glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 448, 512, 64, 0); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); glDisable(GL_ALPHA); //Clear Buffer glClearColor(0,0,0,0); @@ -384,33 +387,6 @@ Procedure TLyricEngine.Draw (Beat: Real); begin DrawLyrics(Beat); -/////// start of debug draw - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_Alpha, GL_ONE_MINUS_SRC_Alpha); - glBindTexture(GL_TEXTURE_2D, PUpperLine^.Tex); - - glColor4f(1,1,0,1); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(100, 100); - glTexCoord2f(0, 0); glVertex2f(100, 200); - glTexCoord2f(1, 0); glVertex2f(612, 200); - glTexCoord2f(1, 1); glVertex2f(612, 100); - glEnd; - - glBindTexture(GL_TEXTURE_2D, PLowerLine^.Tex); - - glColor4f(1,0,1,1); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); glVertex2f(100, 200); - glTexCoord2f(0, 0); glVertex2f(100, 300); - glTexCoord2f(1, 0); glVertex2f(612, 300); - glTexCoord2f(1, 1); glVertex2f(612, 200); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -/////// end of debug draw end; //--------------- @@ -432,7 +408,7 @@ begin True: IEnabled := 0; False: IEnabled:= 1; end; - + glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); @@ -456,28 +432,43 @@ end; procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); var I: Integer; - CurWord: Integer; +// CurWord: Integer; + CurWordStartTx, + CurWordEndTx: Real; // texture-coordinates of start and end of current word + CurWordStart, + CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence Progress: Real; LyricX: Real; //Left Corner on X Axis LyricX2: Real;//Right Corner " " - LyricScale: Real; //Up or Downscale the Lyrics need + LyricScale: Real; //Up or Downscale the Lyrics need <- ??? IconSize: Real; IconAlpha: Real; -begin -{ For I := 0 to High(Line.Words) do - begin - //Set Font Params - SetFontStyle(FontStyle); + mybeat:string; + mywidth:real; + realfontsize:real; +begin +{ SetFontStyle(FontStyle); SetFontSize(Size); - SetFontItalic(Line.Words[I].Freestyle); glColor4f(1, 1, 1, 1); - SetFontPos(Line.Words[I].X, Y); + // line start beat + SetFontPos(50, Y-500); + mybeat:=inttostr(trunc(line^.start*100)); + glPrint(addr(mybeat[1])); - glPrint(PChar(Line.Words[I].Text)); - end; } + // current beat + SetFontPos(250, Y-500); + mybeat:=inttostr(trunc(beat*100)); + glPrint(addr(mybeat[1])); + // current beat + SetFontPos(450, Y-500); + mybeat:=inttostr(trunc((line^.start+line^.length)*100)); + glPrint(addr(mybeat[1])); +} + + // what is this for? LyricScale := Size / Line.Size; //Draw Icons @@ -490,39 +481,145 @@ begin DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} //Check if a Word in the Sentence is active - if ((Line^.Start > Beat) AND (Line^.Start + Line^.Length < Beat)) then + if ((Line^.Start < Beat) and (Beat < Line^.Start + Line^.Length)) 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 not ((Beat < (Line^.Words[Line^.CurWord].Start+Line^.Words[Line^.CurWord].Length))) then + Line^.CurWord:=Line^.CurWord+1; + +// !!TODO: make sure, it works if the sentence is still enabled, after last word was active +// if Line^.CurWord > high(Line^.Words) then Line^.CurWord:=-2; + + with Line^.Words[Line^.CurWord] do + begin + Progress:=(Beat-Start)/Length; + CurWordStartTx:=TexPos; + CurWordEndTx:=TexPos+TexWidth; + CurWordStart:=X; + CurWordEnd:=X+Width; + end; + //Get Start Position: { Start of Line - Width of all Icons + LineWidth/2 (Center} - LyricX := X + (W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3); - - LyricX2 := LyricX + Line^.Width; +// LyricX := X + {(W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3) +} (W/2); + LyricX:=X+W/2; + LyricX2 := LyricX + Line^.Width/2; + LyricX:=LyricX - Line^.Width/2; //Draw complete Sentence - glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + +{ glColor4f(0,1,0.1,0.1); + glBegin(GL_QUADS); + glVertex2f(X+W/2, Y); + glVertex2f(X+W/2, Y + line^.size*3.5); + glVertex2f(X+W/2+line^.width/2, Y + line^.size*3.5); + glVertex2f(X+W/2+line^.width/2, Y); + glEnd; + glColor4f(0,1,0,0.1); + glBegin(GL_QUADS); + glVertex2f(X+W/2-line^.width/2, Y); + glVertex2f(X+W/2-line^.width/2, Y + line^.size*3.5); + glVertex2f(X+W/2, Y + line^.size*3.5); + glVertex2f(X+W/2, Y); + glEnd; + + // draw whole sentence + glEnable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, Line^.Tex); glColorRGB(LineColor_en); glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex2f(LyricX, Y); - glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); - glTexCoord2f(1, 0); glVertex2f(LyricX + LyricX2, Y + 64 * W / 512); - glTexCoord2f(1, 1); glVertex2f(LyricX + LyricX2, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); + glTexCoord2f(Line^.Width/512, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(Line^.Width/512, 1); glVertex2f(LyricX2, Y); + glEnd; +} + // draw sentence up to current word + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); + + glColorRGB(LineColor_act); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); + glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glEnd; + +{ // draw active word - type 1: farbwechsel - HoverEffect=3 oder so? + glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glEnd; + glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glEnd; +} + + // draw active word - type 2: zoom + farbwechsel - HoverEffect=4 ??? +// realfontsize:=30 * (Line^.Size/10); + glPushMatrix; + glTranslatef(LyricX+CurWordStart+(CurWordEnd-CurWordStart)/2,Y+32,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(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -32); + glTexCoord2f(CurWordStartTx+0.0001, 0); glVertex2f(-(CurWordEnd-CurWordStart)/2, + 32); + glTexCoord2f(CurWordEndTx-0.0001, 0); glVertex2f((CurWordEnd-CurWordStart)/2, + 32); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -32); + glEnd; + glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,1); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -32); + glTexCoord2f(CurWordStartTx+0.0001, 0); glVertex2f(-(CurWordEnd-CurWordStart)/2, + 32); + glTexCoord2f(CurWordEndTx-0.0001, 0); glVertex2f((CurWordEnd-CurWordStart)/2, + 32); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -32); + glEnd; + glPopMatrix; + + // draw rest of sentence + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(Line^.Width/1024, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); glEnd; - glDisable(GL_BLEND); glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{ SetFontPos(50, Y); + SetFontSize(9); + mybeat:=line^.words[line^.CurWord].text; + mybeat:=inttostr(trunc(Fonts[actfont].Tex.H)); + glPrint(addr(mybeat[1])); +} end else begin //Get Start Position: { Start of Line - Width of all Icons + LineWidth/2 (Center} - LyricX := X + {(W - ((IconSize + 1) * 6))/2 +} ((IconSize + 1) * 3); - - LyricX2 := LyricX +500{ Line.Width}; +// LyricX := X + {(W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3) +} (W/2); + LyricX:=X+W/2; + LyricX2 := LyricX + Line^.Width/2; + LyricX:=LyricX - Line^.Width/2; //Draw complete Sentence glEnable(GL_TEXTURE_2D); @@ -530,17 +627,44 @@ begin glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, Line^.Tex); - glColorRGB(LineColor_akt); +// realfontsize:=30 * (Line^.Size/10); + + glColorRGB(LineColor_dis); glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex2f(LyricX, Y); - glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64 * W / 512); - glTexCoord2f(1, 0); glVertex2f(LyricX2, Y + 64 * W / 512); - glTexCoord2f(1, 1); glVertex2f(LyricX2, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); + glTexCoord2f(Line^.Width/1024, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); glEnd; + glDisable(GL_TEXTURE_2D); +{ glColor4f(0,0,0,0.1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + line^.size*3.5); + glTexCoord2f(Line^.Width/512, 0); glVertex2f(LyricX2, Y + line^.size*3.5); + glTexCoord2f(Line^.Width/512, 1); glVertex2f(LyricX2, Y); + glEnd; +} glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); +// glDisable(GL_TEXTURE_2D); +{ SetFontPos(0, Y); + SetFontSize(9); + glColor4f(1,1,0,1); + mybeat:=inttostr(line^.size); + glPrint(addr(mybeat[1])); +{ mywidth:=gltextwidth(addr(mybeat[1])); + glEnable(GL_BLEND); + glColor4f(0,0,1,0.1); + glBegin(GL_QUADS); + glVertex2f(0,y); + glVertex2f(0,y+64); + glVertex2f(0+mywidth,y+64); + glVertex2f(0+mywidth,y); + glEnd; + glDisable(GL_BLEND); +} end; -- cgit v1.2.3 From 9f4eaeef7d2100486af9ecbdd1e94e3bd10df3f8 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 16 Dec 2007 11:10:20 +0000 Subject: elimitated sentence change flicker bug git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@704 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 8bbb2db3..8fd1f3ec 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -44,6 +44,7 @@ type TLyricEngine = class private EoLastSentence: Real; //When did the Last Sentence End (in Beats) + LastDrawBeat: Real; UpperLine: TLyricLine; //Line in the Upper Part of the Lyric Display LowerLine: TLyricLine; //Line in the Lower Part of teh Lyric Display QueueLine: TLyricLine; //Line that is in Queue and will be added when next Line is Finished @@ -116,7 +117,8 @@ uses SysUtils, TextGL, UGraphic, UDisplay, - dialogs; + dialogs, + math; //----------- //Helper procs to use TRGB in Opengl ...maybe this should be somewhere else @@ -151,6 +153,7 @@ begin PQueueLine:=@QueueLine; UseLinearFilter := True; + LastDrawBeat:=NAN; end; Constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); @@ -194,6 +197,7 @@ begin PUpperline:=@UpperLine; PLowerLine:=@LowerLine; PQueueLine:=@QueueLine; + LastDrawBeat:=NAN; end; @@ -342,15 +346,12 @@ begin PosX := PosX + LyricLine.Words[I].Width; end; + //Create LyricTexture //Prepare Ogl glGetIntegerv(GL_VIEWPORT, @ViewPort); glClearColor(0.0,0.0,0.0,0.0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - {glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, 1024, 64, 0, -1, 100); - glMatrixMode(GL_MODELVIEW);} glViewPort(0,0,800,600); //Draw Lyrics @@ -368,10 +369,7 @@ begin glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glViewPort(ViewPort[0], ViewPort[1], ViewPort[2], ViewPort[3]); - {glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); } + end; //Increase the Counter @@ -385,8 +383,8 @@ end; //--------------- Procedure TLyricEngine.Draw (Beat: Real); begin - DrawLyrics(Beat); + LastDrawBeat:=Beat; end; //--------------- -- cgit v1.2.3 From 179f9ad2ecad73b3db1d4c9113547d8ceccc9b48 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 16 Dec 2007 11:14:07 +0000 Subject: added some texture parameters (hope this fixes the "strich" problem that mog experienced git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@705 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 8fd1f3ec..c6b42940 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -220,6 +220,9 @@ var //Get Memory 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); -- cgit v1.2.3 From b2910a8978a45fc34fdacf71bffcb9ffbad9cd24 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 16 Dec 2007 11:31:30 +0000 Subject: some adjustment to the way, the lyrics zoom effect works (center of zoom should be more precise now) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@706 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index c6b42940..0d709eef 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -543,6 +543,10 @@ begin glTexCoord2f(Line^.Width/512, 1); glVertex2f(LyricX2, Y); glEnd; } + + // this is actually a bit more than the real font size + // it helps adjusting the "zoom-center" + realfontsize:=30 * (Line^.Size/10)+16; // draw sentence up to current word glEnable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, Line^.Tex); @@ -550,8 +554,8 @@ begin glColorRGB(LineColor_act); glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex2f(LyricX, Y); - glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); - glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(0, 1-realfontsize/64); glVertex2f(LyricX, Y + realfontsize); + glTexCoord2f(CurWordStartTx, 1-realfontsize/64); glVertex2f(LyricX+CurWordStart, Y + realfontsize); glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); glEnd; @@ -573,23 +577,22 @@ begin } // draw active word - type 2: zoom + farbwechsel - HoverEffect=4 ??? -// realfontsize:=30 * (Line^.Size/10); glPushMatrix; - glTranslatef(LyricX+CurWordStart+(CurWordEnd-CurWordStart)/2,Y+32,0); + glTranslatef(LyricX+CurWordStart+(CurWordEnd-CurWordStart)/2,Y+realfontsize/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(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -32); - glTexCoord2f(CurWordStartTx+0.0001, 0); glVertex2f(-(CurWordEnd-CurWordStart)/2, + 32); - glTexCoord2f(CurWordEndTx-0.0001, 0); glVertex2f((CurWordEnd-CurWordStart)/2, + 32); - glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -32); + glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -realfontsize/2); + glTexCoord2f(CurWordStartTx+0.0001, 1-realfontsize/64); glVertex2f(-(CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1-realfontsize/64); glVertex2f((CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -realfontsize/2); glEnd; glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,1); glBegin(GL_QUADS); - glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -32); - glTexCoord2f(CurWordStartTx+0.0001, 0); glVertex2f(-(CurWordEnd-CurWordStart)/2, + 32); - glTexCoord2f(CurWordEndTx-0.0001, 0); glVertex2f((CurWordEnd-CurWordStart)/2, + 32); - glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -32); + glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -realfontsize/2); + glTexCoord2f(CurWordStartTx+0.0001, 1-realfontsize/64); glVertex2f(-(CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1-realfontsize/64); glVertex2f((CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -realfontsize/2); glEnd; glPopMatrix; @@ -597,8 +600,8 @@ begin glColorRGB(LineColor_en); glBegin(GL_QUADS); glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); - glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); - glTexCoord2f(Line^.Width/1024, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(CurWordEndTx, 1-realfontsize/64); glVertex2f(LyricX+CurWordEnd, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1-realfontsize/64); glVertex2f(LyricX2, Y + realfontsize); glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); glEnd; @@ -628,13 +631,13 @@ begin glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glBindTexture(GL_TEXTURE_2D, Line^.Tex); -// realfontsize:=30 * (Line^.Size/10); + realfontsize:=30 * (Line^.Size/10)+16; glColorRGB(LineColor_dis); glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex2f(LyricX, Y); - glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); - glTexCoord2f(Line^.Width/1024, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(0, 1-realfontsize/64); glVertex2f(LyricX, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1-realfontsize/64); glVertex2f(LyricX2, Y + realfontsize); glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); glEnd; -- cgit v1.2.3 From b88a17a87b2ccae7788ecce964bbb8d1b0e877da Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 17 Dec 2007 11:16:51 +0000 Subject: lazarus (was it lazarus?) complained about missing parameters for halt. after removing the bracket it knew it should use the parameter-less version of halt. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@707 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommandLine.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 6a5a4808..e99ee37a 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -96,7 +96,7 @@ begin writeln( ' '+s( cMediaInterfaces ) + ' : Show in-use media interfaces' ); writeln( '' ); - halt(); + halt; end; //------------- -- cgit v1.2.3 From 58ffcecef49caacf566150ea266453fbf61930e9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 17 Dec 2007 11:20:56 +0000 Subject: - removed hStream in favour of TAudioOutputStream - removed all this BASS-specific sound-names git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@708 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_bass.pas | 136 ++++++++++++++++++++++--------------- Game/Code/Classes/UMedia_dummy.pas | 4 +- Game/Code/Classes/UMusic.pas | 8 ++- 3 files changed, 87 insertions(+), 61 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index a7bace06..972d6df0 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -41,6 +41,14 @@ type const ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); +type + TBassOutputStream = class(TAudioOutputStream) + Handle: HSTREAM; + + constructor Create(); overload; + constructor Create(stream: HSTREAM); overload; + end; + type {$IFDEF UseBASSInput} TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput) @@ -48,16 +56,18 @@ type TAudio_bass = class( TInterfacedObject, IAudioPlayback) {$ENDIF} private - BassStart: hStream; // Wait, I've replaced this with BASS - BassBack: hStream; // It has almost all features we need - BassSwoosh: hStream; - BassChange: hStream; // Almost? It aleady has them all :) - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; + MusicStream: HSTREAM; + + StartSoundStream: HSTREAM; + BackSoundStream: HSTREAM; + SwooshSoundStream: HSTREAM; + ChangeSoundStream: HSTREAM; + OptionSoundStream: HSTREAM; + ClickSoundStream: HSTREAM; + DrumSoundStream: HSTREAM; + HihatSoundStream: HSTREAM; + ClapSoundStream: HSTREAM; + ShuffleSoundStream: HSTREAM; //Custom Sounds CustomSounds: array of TCustomSoundEntry; @@ -65,7 +75,6 @@ type Loop: boolean; public - Bass: hStream; function GetName: String; {IAudioOutput interface} @@ -95,7 +104,8 @@ type procedure PlayClap; procedure PlayShuffle; procedure StopShuffle; - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + function LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; //Equalizer function GetFFTData: TFFTData; @@ -128,6 +138,19 @@ type var singleton_MusicBass : IAudioPlayback; + +constructor TBassOutputStream.Create(); +begin + inherited; +end; + +constructor TBassOutputStream.Create(stream: HSTREAM); +begin + Create(); + Handle := stream; +end; + + function TAudio_bass.GetName: String; begin result := 'BASS'; @@ -159,18 +182,18 @@ begin // Log.LogStatus('Loading Sounds', 'Music Initialize'); // Log.BenchmarkStart(4); - LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); + LoadSoundFromFile(StartSoundStream, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BackSoundStream, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(SwooshSoundStream, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(ChangeSoundStream, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(OptionSoundStream, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(ClickSoundStream, SoundPath + 'rimshot022b.mp3'); -// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); +// LoadSoundFromFile(DrumSoundStream, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(HihatSoundStream, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(ClapSoundStream, SoundPath + 'claps050b.mp3'); -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); +// LoadSoundFromFile(ShuffleSoundStream, SoundPath + 'Shuffle.mp3'); // Log.BenchmarkEnd(4); // Log.LogBenchmark('--> Loading Sounds', 4); @@ -196,10 +219,8 @@ begin if Volume < 0 then Volume := 0; - //Set Volume - // TODO : jb_linux replace with something other than bass - BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + BASS_ChannelSetAttributes (MusicStream, -1, Volume, -101); end; procedure TAudio_bass.SetLoop(Enabled: boolean); @@ -212,7 +233,7 @@ begin Loaded := false; if FileExists(Name) then begin - Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + MusicStream := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); Loaded := true; //Set Max Volume @@ -232,8 +253,8 @@ procedure TAudio_bass.MoveTo(Time: real); var bytes: integer; begin - bytes := BASS_ChannelSeconds2Bytes(Bass, Time); - BASS_ChannelSetPosition(Bass, bytes); + bytes := BASS_ChannelSeconds2Bytes(MusicStream, Time); + BASS_ChannelSetPosition(MusicStream, bytes); end; procedure TAudio_bass.Play; @@ -241,27 +262,27 @@ begin if Loaded then begin if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class + BASS_ChannelPlay(MusicStream, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class - BASS_ChannelPlay(Bass, False); // for setting position before playing + BASS_ChannelPlay(MusicStream, False); // for setting position before playing end; end; procedure TAudio_bass.Pause; //Pause Mod begin if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song + BASS_ChannelPause(MusicStream); // Pauses Song end; end; procedure TAudio_bass.Stop; begin - Bass_ChannelStop(Bass); + Bass_ChannelStop(MusicStream); end; procedure TAudio_bass.Close; begin - Bass_StreamFree(Bass); + Bass_StreamFree(MusicStream); end; function TAudio_bass.Length: real; @@ -270,8 +291,8 @@ var begin Result := 60; - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); + bytes := BASS_ChannelGetLength(MusicStream); + Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); end; function TAudio_bass.getPosition: real; @@ -280,15 +301,15 @@ var begin Result := 0; - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); + bytes := BASS_ChannelGetPosition(MusicStream); + Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); end; function TAudio_bass.Finished: boolean; begin Result := false; - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + if BASS_ChannelIsActive(MusicStream) = BASS_ACTIVE_STOPPED then begin Result := true; end; @@ -296,60 +317,60 @@ end; procedure TAudio_bass.PlayStart; begin - BASS_ChannelPlay(BassStart, True); + BASS_ChannelPlay(StartSoundStream, True); end; procedure TAudio_bass.PlayBack; begin - BASS_ChannelPlay(BassBack, True);// then + BASS_ChannelPlay(BackSoundStream, True);// then end; procedure TAudio_bass.PlaySwoosh; begin - BASS_ChannelPlay(BassSwoosh, True); + BASS_ChannelPlay(SwooshSoundStream, True); end; procedure TAudio_bass.PlayChange; begin - BASS_ChannelPlay(BassChange, True); + BASS_ChannelPlay(ChangeSoundStream, True); end; procedure TAudio_bass.PlayOption; begin - BASS_ChannelPlay(BassOption, True); + BASS_ChannelPlay(OptionSoundStream, True); end; procedure TAudio_bass.PlayClick; begin - BASS_ChannelPlay(BassClick, True); + BASS_ChannelPlay(ClickSoundStream, True); end; procedure TAudio_bass.PlayDrum; begin - BASS_ChannelPlay(BassDrum, True); + BASS_ChannelPlay(DrumSoundStream, True); end; procedure TAudio_bass.PlayHihat; begin - BASS_ChannelPlay(BassHihat, True); + BASS_ChannelPlay(HihatSoundStream, True); end; procedure TAudio_bass.PlayClap; begin - BASS_ChannelPlay(BassClap, True); + BASS_ChannelPlay(ClapSoundStream, True); end; procedure TAudio_bass.PlayShuffle; begin - BASS_ChannelPlay(BassShuffle, True); + BASS_ChannelPlay(ShuffleSoundStream, True); end; procedure TAudio_bass.StopShuffle; begin - BASS_ChannelStop(BassShuffle); + BASS_ChannelStop(ShuffleSoundStream); end; -function TAudio_bass.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +function TAudio_bass.LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; var L: Integer; begin @@ -357,13 +378,13 @@ begin begin Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); try - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + stream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); //Add CustomSound L := High(CustomSounds) + 1; SetLength (CustomSounds, L + 1); CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; + CustomSounds[L].Stream := TBassOutputStream.Create(stream); except Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); end; @@ -381,7 +402,7 @@ var Data: TFFTData; begin //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + BASS_ChannelGetData(MusicStream, @Result, BASS_DATA_FFT512); end; {* @@ -394,7 +415,7 @@ var nBytes: DWORD; begin //Get Channel Data Mono and 256 Values - BASS_ChannelGetInfo(Bass, info); + BASS_ChannelGetInfo(MusicStream, info); ZeroMemory(@data, sizeof(TPCMData)); if (info.chans = 1) then @@ -410,7 +431,7 @@ begin else begin // stereo file - nBytes := BASS_ChannelGetData(Bass, @data, sizeof(TPCMData)); + nBytes := BASS_ChannelGetData(MusicStream, @data, sizeof(TPCMData)); end; if(nBytes <= 0) then result := 0 @@ -444,7 +465,10 @@ end; procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); begin if Index <= High(CustomSounds) then - BASS_ChannelPlay(CustomSounds[Index].Handle, True); + with CustomSounds[Index].Stream as TBassOutputStream do + begin + BASS_ChannelPlay(Handle, True); + end; end; {$IFDEF UseBASSInput} diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 697dc2f9..52e3434e 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -82,7 +82,7 @@ type procedure PlayShuffle; procedure StopShuffle; - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + function LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); @@ -251,7 +251,7 @@ procedure Tmedia_dummy.StopShuffle; begin end; -function Tmedia_dummy.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +function Tmedia_dummy.LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; begin result := false; end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 7e1aa839..c2d616ec 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -88,11 +88,12 @@ type TPCMStereoSample = array[0..1] of Smallint; TPCMData = array[0..511] of TPCMStereoSample; - hStream = Cardinal; + TAudioOutputStream = class + end; TCustomSoundEntry = record Filename : String; - Handle : hStream; + Stream : TAudioOutputStream; end; type @@ -149,7 +150,8 @@ type procedure PlayShuffle; procedure StopShuffle; - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + // TODO + //function LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; -- cgit v1.2.3 From 549fd3677bd451169bb45a97ae2da3ee5514622b Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 17 Dec 2007 11:24:51 +0000 Subject: disabled the FFMPEG_AUDIO stuff for the moment git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@709 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 644c62a8..94c8d7ab 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -14,9 +14,6 @@ unit UVideo; //{$define DebugFrames} //{$define Info} -// {$define FFMpegAudio} -{} - interface @@ -49,7 +46,7 @@ uses SDL, dialogs, {$endif} {$ENDIF} - {$ifdef FFMpegAudio} + {$ifdef UseFFMpegAudio} UAudio_FFMpeg, {$endif} UIni, @@ -279,14 +276,16 @@ begin if (AVPacket.stream_index=VideoStreamIndex) then begin errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg - {$ifdef FFMpegAudio} + (* FIXME + {$ifdef UseFFMpegAudio} end else if (AVPacket.stream_index = AudioStreamIndex ) then begin writeln('Encue Audio packet'); - UAudio_FFMpeg.packet_queue_put(UAudio_FFMpeg.audioq, AVPacket); + audioq.put(AVPacket); {$endif} + *) end; try @@ -485,7 +484,8 @@ begin if( AudioStreamIndex >= 0) then aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; - {$ifdef FFMpegAudio} + (* FIXME + {$ifdef UseFFMpegAudio} // This is the audio ffmpeg audio support Jay is working on. if aCodecCtx <> nil then begin @@ -516,15 +516,16 @@ begin avcodec_open(aCodecCtx, aCodec); writeln( 'Opened the codec' ); - + packet_queue_init( audioq ); SDL_PauseAudio(0); - + writeln( 'SDL_PauseAudio' ); - + end; {$endif} + *) if(VideoStreamIndex >= 0) then begin -- cgit v1.2.3 From 6baf1389fddd651e03090ea8008d279696a18e5f Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 17 Dec 2007 11:29:49 +0000 Subject: - non-working ffmpeg-audio test version - "plays" (not at all) only the start-sound at the moment git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@711 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 998 +++++++++++++++++------------------- 1 file changed, 462 insertions(+), 536 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index b89fa00f..f050eaea 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -36,36 +36,6 @@ uses Classes, ULog, UMusic; -type - TPacketQueue = record - first_pkt , - last_pkt : pAVPacketList; - nb_packets : integer; - size : integer; - mutex : pSDL_mutex; - cond : pSDL_cond; - end; - pPacketQueue = ^TPacketQueue; - - function packet_queue_put(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket): integer; - function packet_queue_get(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket; block : integer ): integer; - procedure packet_queue_init( var aPacketQueue : TPacketQueue ); - procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; - function audio_decode_frame(aCodecCtx : TAVCodecContext; aAudio_buf : PUInt8; buf_size: integer): integer; - -var - singleton_MusicFFMpeg : IAudioPlayback = nil; - -var - audioq : TPacketQueue; - quit : integer = 0; -// faudio_buf : array[ 0 .. 0 ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} -// audio_buf : array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} - -type - Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE-1 ] of byte; - PAudioBuff = ^Taudiobuff; - implementation uses @@ -73,55 +43,104 @@ uses lclintf, libc, {$ENDIF} -// URecord, UIni, UMain, UThemes; -//var -// singleton_MusicFFMpeg : IAudioPlayback = nil; +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + firstPkt, + lastPkt : PAVPacketList; + nbPackets : integer; + size : integer; + mutex : PSDL_Mutex; + cond : PSDL_Cond; + quit : boolean; -const - RecordSystem = 1; - SDL_AUDIO_BUFFER_SIZE = 1024; - + public + constructor Create(); + + function Put(pkt : PAVPacket): integer; + function Get(var pkt: TAVPacket; block: boolean): integer; + end; type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, mpPaused, mpOpen); + TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); +const + StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); +type + PAudioBuffer = ^TAudioBuffer; + TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + SDL_AUDIO_BUFFER_SIZE = 1024; + +type + TFFMpegOutputStream = class(TAudioOutputStream) + private + parseThread: PSDL_Thread; + packetQueue: TPacketQueue; + + status: TStreamStatus; + + // FFMpeg internal data + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + + // static vars for AudioDecodeFrame + pkt : TAVPacket; + audio_pkt_data : PChar; + audio_pkt_size : integer; + + // static vars for AudioCallback + audio_buf_index : cardinal; + audio_buf_size : cardinal; + audio_buf : TAudioBuffer; + public + constructor Create(); overload; + constructor Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; + procedure Play(); + procedure Pause(); + procedure Stop(); + procedure Close(); + function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; + end; type - TAudio_ffMpeg = class( TInterfacedObject, IAudioPlayback ) + TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) private - - BassStart: hStream; - BassBack: hStream; - BassSwoosh: hStream; - BassChange: hStream; - BassOption: hStream; - BassClick: hStream; - BassDrum: hStream; - BassHihat: hStream; - BassClap: hStream; - BassShuffle: hStream; + MusicStream: TFFMpegOutputStream; + + StartSoundStream: TFFMpegOutputStream; + BackSoundStream: TFFMpegOutputStream; + SwooshSoundStream: TFFMpegOutputStream; + ChangeSoundStream: TFFMpegOutputStream; + OptionSoundStream: TFFMpegOutputStream; + ClickSoundStream: TFFMpegOutputStream; + DrumSoundStream: TFFMpegOutputStream; + HihatSoundStream: TFFMpegOutputStream; + ClapSoundStream: TFFMpegOutputStream; + ShuffleSoundStream: TFFMpegOutputStream; //Custom Sounds CustomSounds: array of TCustomSoundEntry; Loaded: boolean; Loop: boolean; - fHWND: THandle; - function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; public -// Bass: hStream; - constructor create(); function GetName: String; procedure InitializePlayback; procedure SetVolume(Volume: integer); @@ -148,105 +167,120 @@ type procedure PlayClap; procedure PlayShuffle; procedure StopShuffle; -// procedure CaptureStart; -// procedure CaptureStop; -// procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function LoadSoundFromFile(var hStream: hStream; Name: string): boolean; + + function LoadSoundFromFile(Name: string): TFFMpegOutputStream; //Equalizer function GetFFTData: TFFTData; + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); -end; + end; -constructor TAudio_ffMpeg.create(); +var + singleton_MusicFFMpeg : IAudioPlayback = nil; + + +function ParseAudio(data: Pointer): integer; cdecl; forward; +procedure AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; + +constructor TFFMpegOutputStream.Create(); begin -// writeln( 'UVideo_FFMpeg - av_register_all' ); - av_register_all; + inherited; + + packetQueue := TPacketQueue.Create(); + + FillChar(pkt, sizeof(TAVPacket), #0); + + status := sStopped; + + audio_pkt_data := nil; + audio_pkt_size := 0; + + audio_buf_index := 0; + audio_buf_size := 0; end; -function TAudio_ffMpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; -var - i : integer; - st : pAVStream; +constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); begin - // Find the first video stream - aFirstAudioStream := -1; - aFirstVideoStream := -1; + Create(); + Self.pFormatCtx := pFormatCtx; + Self.pCodecCtx := pCodecCtx; + Self.pCodec := pCodec; + Self.ffmpegStreamID := ffmpegStreamID; + Self.ffmpegStream := ffmpegStream; +end; - i := 0; - while ( i < aFormatCtx.nb_streams ) do +procedure TFFMpegOutputStream.Play(); +begin + writeln('Play request'); + if(status = sStopped) then begin -// writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); - st := aFormatCtx.streams[i]; + writeln('Play ok'); + status := sPlaying; + Self.parseThread := SDL_CreateThread(@ParseAudio, Self); + SDL_PauseAudio(0); + end; +end; - if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND - (aFirstVideoStream < 0) THEN - begin -// writeln( 'Found Video Stream' ); - aFirstVideoStream := i; - end; +procedure TFFMpegOutputStream.Pause(); +begin +end; - if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND - ( aFirstAudioStream < 0) THEN - begin -// writeln( 'Found Audio Stream' ); - aFirstAudioStream := i; - end; +procedure TFFMpegOutputStream.Stop(); +begin +end; - inc( i ); - end; // while +procedure TFFMpegOutputStream.Close(); +begin + // Close the codec + avcodec_close(pCodecCtx); - result := (aFirstAudioStream > -1) OR - (aFirstVideoStream > -1) ; // Didn't find any streams stream + // Close the video file + av_close_input_file(pFormatCtx); end; -function TAudio_ffMpeg.GetName: String; +function TAudio_FFMpeg.GetName: String; begin result := 'FFMpeg'; end; -procedure TAudio_ffMpeg.InitializePlayback; -var -// Pet: integer; - S: integer; +procedure TAudio_FFMpeg.InitializePlayback; begin + Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); -// LoadSoundFromFile(BassStart, SoundPath + 'Green Day - American Idiot.mp3'); - -(* - LoadSoundFromFile(BassStart, SoundPath + 'Common start.mp3'); - LoadSoundFromFile(BassBack, SoundPath + 'Common back.mp3'); - LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3'); - - LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3'); - LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3'); - LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3'); -*) + Loaded := false; + Loop := false; -// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3'); + av_register_all(); + SDL_Init(SDL_INIT_AUDIO); -// Log.BenchmarkEnd(4); -// Log.LogBenchmark('--> Loading Sounds', 4); + StartSoundStream := LoadSoundFromFile(SoundPath + 'Common Start.mp3'); + { + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); + SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); + ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); + OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); + ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); + } +// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); +// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); +// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); +// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); end; -procedure TAudio_ffMpeg.SetVolume(Volume: integer); +procedure TAudio_FFMpeg.SetVolume(Volume: integer); begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); //New: Sets Volume only for this Application - - - // TODO : jb_linux replace with something other than bass (* BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); @@ -254,7 +288,7 @@ begin *) end; -procedure TAudio_ffMpeg.SetMusicVolume(Volume: Integer); +procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); begin //Max Volume Prevention if Volume > 100 then @@ -265,112 +299,102 @@ begin //Set Volume - // TODO : jb_linux replace with something other than bass // BASS_ChannelSetAttributes (Bass, -1, Volume, -101); end; -procedure TAudio_ffMpeg.SetLoop(Enabled: boolean); +procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); begin Loop := Enabled; end; -function TAudio_ffMpeg.Open(Name: string): boolean; +function TAudio_FFMpeg.Open(Name: string): boolean; begin Loaded := false; if FileExists(Name) then begin - // TODO : jb_linux replace with something other than bass // Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - + Loaded := true; //Set Max Volume -// SetMusicVolume (100); + SetMusicVolume (100); end; Result := Loaded; end; -procedure TAudio_ffMpeg.Rewind; +procedure TAudio_FFMpeg.Rewind; begin if Loaded then begin end; end; -procedure TAudio_ffMpeg.MoveTo(Time: real); +procedure TAudio_FFMpeg.MoveTo(Time: real); var bytes: integer; begin - // TODO : jb_linux replace with something other than bass // bytes := BASS_ChannelSeconds2Bytes(Bass, Time); // BASS_ChannelSetPosition(Bass, bytes); end; -procedure TAudio_ffMpeg.Play; +procedure TAudio_FFMpeg.Play; begin -(* - // TODO : jb_linux replace with something other than bass + if MusicStream <> nil then if Loaded then begin if Loop then - BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_ffMpeg Class - - BASS_ChannelPlay(Bass, False); // for setting position before playing + begin + end; + // start from beginning... + // actually bass itself does not loop, nor does this TAudio_FFMpeg Class + MusicStream.Play(); end; -*) end; -procedure TAudio_ffMpeg.Pause; //Pause Mod +procedure TAudio_FFMpeg.Pause; //Pause Mod begin -(* - // TODO : jb_linux replace with something other than bass + if MusicStream <> nil then if Loaded then begin - BASS_ChannelPause(Bass); // Pauses Song + MusicStream.Pause(); // Pauses Song end; -*) end; -procedure TAudio_ffMpeg.Stop; +procedure TAudio_FFMpeg.Stop; begin -// Bass_ChannelStop(Bass); + if MusicStream <> nil then + MusicStream.Stop(); end; -procedure TAudio_ffMpeg.Close; +procedure TAudio_FFMpeg.Close; begin -// Bass_StreamFree(Bass); + if MusicStream <> nil then + MusicStream.Close(); end; -function TAudio_ffMpeg.Length: real; +function TAudio_FFMpeg.Length: real; var - bytes: integer; + bytes: integer; begin - Result := 60; -(* - // TODO : jb_linux replace with something other than bass - bytes := BASS_ChannelGetLength(Bass); - Result := BASS_ChannelBytes2Seconds(Bass, bytes); -*) + Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; end; -function TAudio_ffMpeg.getPosition: real; +function TAudio_FFMpeg.getPosition: real; var - bytes: integer; + bytes: integer; begin Result := 0; (* - // TODO : jb_linux replace with something other than bass bytes := BASS_ChannelGetPosition(BASS); Result := BASS_ChannelBytes2Seconds(BASS, bytes); *) end; -function TAudio_ffMpeg.Finished: boolean; +function TAudio_FFMpeg.Finished: boolean; begin Result := false; (* - // TODO : jb_linux replace with something other than bass if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then begin Result := true; @@ -378,215 +402,166 @@ begin *) end; -procedure TAudio_ffMpeg.PlayStart; +procedure TAudio_FFMpeg.PlayStart; begin - // LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); - - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassStart, True); + if StartSoundStream <> nil then + StartSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayBack; +procedure TAudio_FFMpeg.PlayBack; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassBack, True);// then + if BackSoundStream <> nil then + BackSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlaySwoosh; +procedure TAudio_FFMpeg.PlaySwoosh; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassSwoosh, True); - - + if SwooshSoundStream <> nil then + SwooshSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayChange; +procedure TAudio_FFMpeg.PlayChange; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassChange, True); + if ChangeSoundStream <> nil then + ChangeSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayOption; +procedure TAudio_FFMpeg.PlayOption; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassOption, True); + if OptionSoundStream <> nil then + OptionSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayClick; +procedure TAudio_FFMpeg.PlayClick; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassClick, True); + if ClickSoundStream <> nil then + ClickSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayDrum; +procedure TAudio_FFMpeg.PlayDrum; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassDrum, True); + if DrumSoundStream <> nil then + DrumSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayHihat; +procedure TAudio_FFMpeg.PlayHihat; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassHihat, True); + if HihatSoundStream <> nil then + HihatSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayClap; +procedure TAudio_FFMpeg.PlayClap; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassClap, True); + if ClapSoundStream <> nil then + ClapSoundStream.Play(); end; -procedure TAudio_ffMpeg.PlayShuffle; +procedure TAudio_FFMpeg.PlayShuffle; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelPlay(BassShuffle, True); + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Play(); end; -procedure TAudio_ffMpeg.StopShuffle; +procedure TAudio_FFMpeg.StopShuffle; begin - // TODO : jb_linux replace with something other than bass -// BASS_ChannelStop(BassShuffle); + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Stop(); end; -procedure TAudio_ffMpeg.StopCard(Card: byte); -begin - - // TODO : jb_linux replace with something other than bass -// BASS_RecordSetDevice(Card); -// BASS_RecordFree; -end; - -function audio_decode_frame(aCodecCtx : TAVCodecContext; aAudio_buf : PUInt8; buf_size: integer): integer; +function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; var - pkt : TAVPacket; - audio_pkt_data : pchar;//PUInt8 = nil; - audio_pkt_size : integer; - len1 , - data_size : integer; + len1, + data_size: integer; begin result := -1; -(* - {$ifdef win32} - FillChar(pkt, sizeof(TAVPacket), #0); - {$else} - memset(@pkt, 0, sizeof(TAVPacket)); // todo : jb memset - {$endif} - - audio_pkt_data := nil; - audio_pkt_size := 0; + if (buffer = nil) then + exit; while true do - begin - - while ( audio_pkt_size > 0 ) do + begin + while (audio_pkt_size > 0) do begin // writeln( 'got audio packet' ); - data_size := buf_size; - - len1 := -1; + data_size := bufSize; - if aAudio_buf <> nil then - begin - len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. - end; + // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), + data_size, audio_pkt_data, audio_pkt_size); -// writeln('avcodec_decode_audio : ' + inttostr( len1 )); + writeln('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin - //* if error, skip frame */ - writeln( 'Skip audio frame' ); + // if error, skip frame +// writeln( 'Skip audio frame' ); audio_pkt_size := 0; break; end; - + audio_pkt_data := audio_pkt_data + len1; audio_pkt_size := audio_pkt_size + len1; - + if (data_size <= 0) then begin - //* No data yet, get more frames */ + // No data yet, get more frames continue; end; - - //* We have data, return it and come back for more later */ + + // We have data, return it and come back for more later result := data_size; exit; end; - if ( pkt.data <> nil ) then - av_free_packet( pkt ); + if (pkt.data <> nil) then + av_free_packet(pkt); - if ( quit <> 0 ) then + if (packetQueue.quit) then begin result := -1; exit; end; - if (packet_queue_get(audioq, pkt, 1) < 0) then + if (packetQueue.Get(pkt, true) < 0) then begin result := -1; exit; end; - - audio_pkt_data := pchar( pkt.data ); + audio_pkt_data := PChar(pkt.data); audio_pkt_size := pkt.size; // writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; *) + end; end; -procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); +procedure AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; var - audio_buf_index : cardinal; // static unsigned int audio_buf_index = 0; - audio_buf_size : cardinal; // static unsigned int audio_buf_size = 0; - audio_size , - len1 : integer; - aCodecCtx : TAVCodecContext; - - lSrc : pointer; - - // this is used to emulate ...... static uint8_t audio_buf[(AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) / 2]; - lAudio_buf_data : Taudiobuff; // This created the memory we need - laudio_buf : PAudioBuff; // this makes it easy to work with.. since its the pointer to that memeory everywhere + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; begin - laudio_buf := @lAudio_buf_data ; - - aCodecCtx := pAVCodecContext(userdata)^; - audio_size := -1; - audio_buf_index := 0; - audio_buf_size := 0; + outStream := TFFMpegOutputStream(userdata); while (len > 0) do - begin - + with outStream do begin if (audio_buf_index >= audio_buf_size) then begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + writeln('audio_decode_frame : '+ inttostr(audio_size)); - // We have already sent all our data; get more */ - audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(Taudiobuff)); - writeln( 'audio_decode_frame : ' + inttostr( audio_size ) + ' / ' + inttostr( sizeof(Taudiobuff) ) ); - - if(audio_size > 0) then + if(audio_size < 0) then begin - audio_buf_size := audio_size; + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + writeln( 'Silence' ); end else begin - // If error, output silence */ - -// audio_buf_size := 1024; // arbitrary? - -// {$ifdef win32} -// FillChar(laudio_buf, audio_buf_size, #0); -// {$else} -// memset(laudio_buf, 0, audio_buf_size); // todo : jb memset -// {$endif} - - writeln( 'Silence' ); + audio_buf_size := audio_size; end; - audio_buf_index := 0; // Todo : jb - SegFault ? end; @@ -594,354 +569,305 @@ begin if (len1 > len) then len1 := len; - lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); + pSrc := PChar(@audio_buf) + audio_buf_index; {$ifdef WIN32} - CopyMemory(stream, lSrc , len1); + CopyMemory(stream, pSrc , len1); {$else} - memcpy(stream, lSrc , len1); + memcpy(stream, pSrc , len1); {$endif} - len := len - len1; - stream^ := stream^ + len1; - audio_buf_index := audio_buf_index + len1; + Dec(len, len1); + Inc(stream, len1); + Inc(audio_buf_index, len1); end; end; -function TAudio_ffMpeg.LoadSoundFromFile(var hStream: hStream; Name: string): boolean; +function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; var - L : Integer; - pFormatCtx : PAVFormatContext; - lVidStreamID , - lAudStreamID : Integer; - aCodecCtx : pAVCodecContext; - wanted_spec , - spec : TSDL_AudioSpec; - lAudioStream : pAVStream; - aCodec : pAVCodec; - i : integer; - packet : TAVPacket; - event : TSDL_Event; -begin - result := false; + i : integer; + streamID: integer; + stream : PAVStream; +begin + // Find the first audio stream + streamID := -1; - if FileExists(Name) then + for i := 0 to pFormatCtx^.nb_streams-1 do begin - writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - - // Open video file - if (av_open_input_file(pFormatCtx, pchar(Name), nil, 0, nil) > 0) then - exit; + //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); + stream := pFormatCtx^.streams[i]; - // Retrieve stream information - if (av_find_stream_info(pFormatCtx)<0) then - exit; - - dump_format(pFormatCtx, 0, pchar(Name), 0); - - if not find_stream_ids( pFormatCtx, lVidStreamID, lAudStreamID ) then - exit; - -// writeln( 'done searching for stream ids' ); - - if lAudStreamID > -1 then - begin -// writeln( 'Audio Stream ID is : '+ inttostr( lAudStreamID ) ); - - lAudioStream := pFormatCtx.streams[lAudStreamID]; - aCodecCtx := lAudioStream.codec; - - // Set audio settings from codec info - wanted_spec.freq := aCodecCtx.sample_rate; - wanted_spec.format := AUDIO_S16SYS; - wanted_spec.channels := aCodecCtx.channels; - wanted_spec.silence := 0; - wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; - wanted_spec.callback := audio_callback; - wanted_spec.userdata := aCodecCtx; - end; - - if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then - begin - writeln('SDL_OpenAudio: '+SDL_GetError()); - exit + if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then + begin + Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); + streamID := i; + break; + end; end; -// writeln( 'SDL opened audio device' ); - - aCodec := avcodec_find_decoder(aCodecCtx.codec_id); - if (aCodec = nil) then - begin - writeln('Unsupported codec!'); - exit; - end; + result := streamID; +end; - avcodec_open(aCodecCtx, aCodec); +function ParseAudio(data: Pointer): integer; cdecl; +var + packet: TAVPacket; + stream: TFFMpegOutputStream; +begin + stream := TFFMpegOutputStream(data); -// writeln( 'Opened the codec' ); - - packet_queue_init( audioq ); - SDL_PauseAudio(0); - -// writeln( 'SDL_PauseAudio' ); - - i := 0; - while (av_read_frame(pFormatCtx, packet) >= 0) do + while (av_read_frame(stream.pFormatCtx, packet) >= 0) do begin -// writeln( 'ffmpeg - av_read_frame' ); - - if (packet.stream_index = lAudStreamID ) then + writeln( 'ffmpeg - av_read_frame' ); + + if (packet.stream_index = stream.ffmpegStreamID) then begin -// writeln( 'packet_queue_put' ); - packet_queue_put(audioq, packet); + //writeln( 'packet_queue_put' ); + stream.packetQueue.put(@packet); end else begin av_free_packet(packet); end; + end; + Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); - // Free the packet that was allocated by av_read_frame - SDL_PollEvent(@event); + result := 0; +end; -(* - if event.type_ = SDL_QUIT the - begin - quit := 1; - SDL_Quit(); - end - else - break; -*) +function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; +var + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + wanted_spec, + spec : TSDL_AudioSpec; + csIndex : integer; + stream : TFFMpegOutputStream; +begin + result := nil; + + if (not FileExists(Name)) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); + exit; end; - - writeln( 'Done filling buffer' ); -// halt(0); + // Open audio file + if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then + exit; - // Close the codec -// avcodec_close(aCodecCtx); + // Retrieve stream information + if (av_find_stream_info(pFormatCtx) < 0) then + exit; - // Close the video file -// av_close_input_file(pFormatCtx); + dump_format(pFormatCtx, 0, pchar(Name), 0); -(* - try - // TODO : jb_linux replace with something other than bass - hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Handle := hStream; - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; -*) - - end - else + ffmpegStreamID := FindAudioStreamID(pFormatCtx); + if (ffmpegStreamID < 0) then + exit; + + //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + + ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; + pCodecCtx := ffmpegStream^.codec; + + pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); + if (pCodec = nil) then begin - writeln('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); exit; end; + avcodec_open(pCodecCtx, pCodec); + //writeln( 'Opened the codec' ); + + stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, + ffmpegStreamID, ffmpegStream); + + // Set SDL audio settings from codec info + wanted_spec.freq := pCodecCtx^.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := pCodecCtx^.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := AudioCallback; + wanted_spec.userdata := stream; + + // TODO: this works only one time (?) + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); + stream.Free(); + exit + end; + + Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); + + //Add CustomSound + csIndex := High(CustomSounds) + 1; + SetLength (CustomSounds, csIndex + 1); + CustomSounds[csIndex].Filename := Name; + CustomSounds[csIndex].Stream := stream; + + result := stream; end; -procedure packet_queue_init(var aPacketQueue : TPacketQueue ); +//Equalizer +function TAudio_FFMpeg.GetFFTData: TFFTData; +var + data: TFFTData; begin - {$ifdef win32} - FillChar(aPacketQueue, sizeof(TPacketQueue), #0); - {$else} - memset(@aPacketQueue, 0, sizeof(TPacketQueue)); - {$endif} - - aPacketQueue.mutex := SDL_CreateMutex(); - aPacketQueue.cond := SDL_CreateCond(); + //Get Channel Data Mono and 256 Values +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + result := data; +end; + +// Interface for Visualizer +function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + +function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; +var + S: TFFMpegOutputStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + S := LoadSoundFromFile(SoundPath + Filename); + if (S <> nil) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); end; -function packet_queue_put(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket): integer; + +constructor TPacketQueue.Create(); +begin + inherited; + + firstPkt := nil; + lastPkt := nil; + nbPackets := 0; + size := 0; + + mutex := SDL_CreateMutex(); + cond := SDL_CreateCond(); +end; + +function TPacketQueue.Put(pkt : PAVPacket): integer; var - pkt1 : pAVPacketList; + pkt1 : PAVPacketList; begin result := -1; - -// writeln( 'TAudio_ffMpeg.packet_queue_put' ); - - if av_dup_packet(@AVPacket) < 0 then + + if (av_dup_packet(pkt) < 0) then exit; pkt1 := av_malloc(sizeof(TAVPacketList)); if (pkt1 = nil) then exit; - - pkt1.pkt := AVPacket; - pkt1.next := nil; + + pkt1^.pkt := pkt^; + pkt1^.next := nil; - SDL_LockMutex( aPacketQueue.mutex ); + SDL_LockMutex(Self.mutex); try - if (aPacketQueue.last_pkt = nil) then - aPacketQueue.first_pkt := pkt1 + if (Self.lastPkt = nil) then + Self.firstPkt := pkt1 else - aPacketQueue.last_pkt.next := pkt1; + Self.lastPkt^.next := pkt1; - aPacketQueue.last_pkt := pkt1; - inc( aPacketQueue.nb_packets ); - - aPacketQueue.size := aPacketQueue.size + pkt1.pkt.size; - SDL_CondSignal(aPacketQueue.cond); + Self.lastPkt := pkt1; + inc(Self.nbPackets); + + Writeln('Put: ' + inttostr(nbPackets)); + + Self.size := Self.size + pkt1^.pkt.size; + SDL_CondSignal(Self.cond); finally - SDL_UnlockMutex( aPacketQueue.mutex ); + SDL_UnlockMutex(Self.mutex); end; result := 0; end; -function packet_queue_get(var aPacketQueue : TPacketQueue; var AVPacket : TAVPacket; block : integer ): integer; +function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; var - pkt1 : pAVPacketList; + pkt1 : PAVPacketList; begin result := -1; -// writeln( 'packet_queue_get' ); - - SDL_LockMutex(aPacketQueue.mutex); + + SDL_LockMutex(Self.mutex); try while true do begin - - if (quit <> 0) then + if (quit) then exit; - pkt1 := aPacketQueue.first_pkt; - - if ( pkt1 <> nil ) then + pkt1 := Self.firstPkt; + + if (pkt1 <> nil) then begin - aPacketQueue.first_pkt := pkt1.next; - - if (aPacketQueue.first_pkt = nil ) then - aPacketQueue.last_pkt := nil; - - dec(aPacketQueue.nb_packets); - - aPacketQueue.size := aPacketQueue.size - pkt1.pkt.size; - - AVPacket := pkt1.pkt; + Self.firstPkt := pkt1.next; + if (Self.firstPkt = nil) then + Self.lastPkt := nil; + dec(Self.nbPackets); + + Writeln('Get: ' + inttostr(nbPackets)); + Self.size := Self.size - pkt1^.pkt.size; + pkt := pkt1^.pkt; av_free(pkt1); result := 1; break; end else - if (block = 0) then + if (not block) then begin result := 0; break; end else begin - SDL_CondWait(aPacketQueue.cond, aPacketQueue.mutex); + SDL_CondWait(Self.cond, Self.mutex); end; end; finally - SDL_UnlockMutex(aPacketQueue.mutex); - end; -end; - - -//Equalizer -function TAudio_ffMpeg.GetFFTData: TFFTData; -var - Data: TFFTData; -begin - //Get Channel Data Mono and 256 Values -// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); -end; - -function TAudio_ffMpeg.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin -(* - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; + SDL_UnlockMutex(Self.mutex); end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -*) end; -procedure TAudio_ffMpeg.PlayCustomSound(const Index: Cardinal ); -begin -// if Index <= High(CustomSounds) then -// BASS_ChannelPlay(CustomSounds[Index].Handle, True); -end; - - -{* - -Sorry guys... this is my mess :( -Im going to try and get ffmpeg to handle audio playback ( at least for linux ) -and Im going to implement it nicly along side BASS, in TAudio_ffMpeg ( where I can ) - -http://www.dranger.com/ffmpeg/ffmpeg.html -http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - -http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*} -{* -function TAudio_ffMpeg.FFMPeg_StreamCreateFile(abool : boolean; aFileName : pchar ): THandle; -var - lFormatCtx : PAVFormatContext; -begin - -(* - if(SDL_OpenAudio(&wanted_spec, &spec) < 0) - begin - fprintf(stderr, "SDL_OpenAudio: %s\n", SDL_GetError()); - writeln( 'SDL_OpenAudio' ); - exit; - end; -*) - -(* - if ( av_open_input_file( lFormatCtx, aFileName, NULL, 0, NULL ) <> 0 ) - begin - writeln( 'Unable to open file '+ aFileName ); - exit; - end; - - // Retrieve stream information - if ( av_find_stream_info(pFormatCtx) < 0 ) - begin - writeln( 'Unable to Retrieve stream information' ); - exit; - end; -*) -end; *} initialization - singleton_MusicFFMpeg := TAudio_ffMpeg.create(); + singleton_MusicFFMpeg := TAudio_FFMpeg.create(); - writeln( 'UAudio_Bass - Register Playback' ); + writeln( 'UAudio_FFMpeg - Register Playback' ); AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); finalization -- cgit v1.2.3 From 65cd744909a51e2c9adcfbd3bbbeee096b35b111 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 17 Dec 2007 16:40:13 +0000 Subject: - faster preset switching - added projectM 1.0 support git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@715 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVisualizer.pas | 761 +++++++++++++++++++------------------- 1 file changed, 378 insertions(+), 383 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 6548e2b7..5fc4bb82 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -1,383 +1,378 @@ -{############################################################################ -# Visualizer support for UltraStar deluxe # -# # -# Created by hennymcc # -# Slight modifications by Jay Binks # -# based on UVideo.pas # -#############################################################################} - -unit UVisualizer; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses SDL, - UGraphicClasses, - textgl, - math, - OpenGL12, - SysUtils, - UIni, - {$ifdef DebugDisplay} - dialogs, - {$ENDIF} - projectM, - UMusic; - -implementation - -uses - UGraphic; - -var - singleton_VideoProjectM : IVideoPlayback; - -const - gx = 32; - gy = 24; - fps = 30; - texsize = 512; - visuals_Dir = 'Visuals'; // TODO: move this to a place common for all visualizers - projectM_Dir = visuals_Dir+'/projectM'; - -type - TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) - - pm : PProjectM; - - VisualizerStarted , - VisualizerPaused : Boolean; - - VisualTex : glUint; - PCMData : TPCMData; - hRC : Integer; - hDC : Integer; - - RndPCMcount : integer; - - procedure VisualizerStart; - procedure VisualizerStop; - - procedure VisualizerTogglePause; - - function GetRandomPCMData(var data: TPCMData): Cardinal; - public - constructor create(); - procedure init(); - function GetName: String; - - function Open( aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure MoveTo(Time: real); - function getPosition: real; - - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); - end; - - -constructor TVideoPlayback_ProjectM.create(); -begin - RndPCMcount := 0; -end; - - -procedure TVideoPlayback_ProjectM.init(); -begin - VisualizerStarted := False; - VisualizerPaused := False; - - glGenTextures(1, PglUint(@VisualTex)); - glBindTexture(GL_TEXTURE_2D, VisualTex); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); -end; - -function TVideoPlayback_ProjectM.GetName: String; -begin - result := 'ProjectM'; -end; - - -function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed -begin - VisualizerStart(); - result := true; -end; - -procedure TVideoPlayback_ProjectM.Close; -begin -end; - -procedure TVideoPlayback_ProjectM.Play; -begin - VisualizerStart(); -end; - -procedure TVideoPlayback_ProjectM.Pause; -begin - VisualizerTogglePause(); -end; - -procedure TVideoPlayback_ProjectM.Stop; -begin - VisualizerStop(); -end; - -procedure TVideoPlayback_ProjectM.MoveTo(Time: real); -begin - // this code MAY be able to be cut down... but Im not 100% sure.. - // in here, we cant realy move to a specific time, since its all random generated - // but a call to this function will change the preset, which changes the pattern - projectM_reset(pm); - - pm^.fullscreen := 0; - pm^.renderTarget^.texsize := texsize; - pm^.gx := gx; - pm^.gy := gy; - pm^.fps := fps; - pm^.renderTarget^.usePbuffers := 0; - - pm^.fontURL := PChar(projectM_Dir+'/fonts'); - pm^.presetURL := PChar(projectM_Dir+'/presets'); - - glPushAttrib(GL_ALL_ATTRIB_BITS); - projectM_init(pm); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - projectM_resetGL(pm, ScreenW, ScreenH); - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); - glPopAttrib(); - -end; - -function TVideoPlayback_ProjectM.getPosition: real; -begin - result := 0; -end; - -procedure TVideoPlayback_ProjectM.VisualizerStart; -begin - VisualizerStarted := True; - - New(pm); - projectM_reset(pm); - - pm^.fullscreen := 0; - pm^.renderTarget^.texsize := texsize; - pm^.gx := gx; - pm^.gy := gy; - pm^.fps := fps; - pm^.renderTarget^.usePbuffers := 0; - - pm^.fontURL := PChar(projectM_Dir+'/fonts'); - pm^.presetURL := PChar(projectM_Dir+'/presets'); - - glPushAttrib(GL_ALL_ATTRIB_BITS); - projectM_init(pm); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - projectM_resetGL(pm, ScreenW, ScreenH); - - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); - glPopAttrib(); -end; - -procedure TVideoPlayback_ProjectM.VisualizerStop; -begin - if VisualizerStarted then begin - VisualizerStarted := False; - Dispose(pm); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerTogglePause; -begin - VisualizerPaused := not VisualizerPaused; -end; - -procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); -var - i: integer; - nSamples: cardinal; -begin - if not VisualizerStarted then Exit; - if VisualizerPaused then Exit; - - // get audio data - nSamples := AudioPlayback.GetPCMData(PcmData); - - if nSamples = 0 then - nSamples := GetRandomPCMData(PcmData); - - addPCM16Data(PPCM16Data(@PcmData), nSamples); - - // store OpenGL state (might be messed up otherwise) - glPushAttrib(GL_ALL_ATTRIB_BITS); - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glMatrixMode(GL_TEXTURE); - glPushMatrix(); - - // let projectM render a frame - try - renderFrame(pm); - except - // This happens with some presets... ( and only some times also .. moreso on linux ) - // if we have an "Invalid Floating Point Error" while rendering a frame... then change preset. - MoveTo( now ); - - // hmm have to be careful, that we dont get to many here... coz it could keep failing.. and trying again. - end; - glFlush(); - - {$IFDEF UseTexture} - glBindTexture(GL_TEXTURE_2D, VisualTex); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); - {$ENDIF} - - // restore USDX OpenGL state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - glMatrixMode(GL_TEXTURE); - glPopMatrix(); - glPopAttrib(); - - // discard projectM's depth buffer information (avoid overlay) - glClear(GL_DEPTH_BUFFER_BIT); -end; - -procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); -begin - {$IFDEF UseTexture} - // 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 VisualizerStarted then Exit; - - // setup display - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glLoadIdentity(); - gluOrtho2D(0, 1, 0, 1); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glLoadIdentity(); - - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glBindTexture(GL_TEXTURE_2D, VisualTex); - glColor4f(1, 1, 1, 1); - - // draw projectM frame - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(1, 0); glVertex2f(1, 0); - glTexCoord2f(1, 1); glVertex2f(1, 1); - glTexCoord2f(0, 1); glVertex2f(0, 1); - glEnd(); - - { - glbegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(400-VisualWidth/2, 300-VisualHeight/2); - glTexCoord2f(0, 1); - glVertex2f(400-VisualWidth/2, 300+VisualHeight/2); - glTexCoord2f(1, 1); - glVertex2f(400+VisualWidth/2, 300+VisualHeight/2); - glTexCoord2f(1, 0); - glVertex2f(400+VisualWidth/2, 300-VisualHeight/2); - glEnd; - } - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // restore state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - {$ENDIF} -end; - -function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; -var - i: integer; -begin - // Produce some fake PCM data - if ( RndPCMcount mod 500 = 0 ) then - begin - for i := 0 to 511 do begin - data[0][i] := 0; - data[1][i] := 0; - end; - end - else begin - for i := 0 to 511 do begin - if ( i mod 2 = 0 ) then begin - data[0][i] := floor(Random * power(2.,14)); - data[1][i] := floor(Random * power(2.,14)); - end - else begin; - data[0][i] := floor(Random * power(2.,14)); - data[1][i] := floor(Random * power(2.,14)); - end; - if ( i mod 2 = 1 ) then begin - data[0][i] := -data[0][i]; - data[1][i] := -data[1][i]; - end; - end; - end; - Inc( RndPCMcount ); - result := 512; -end; - - -initialization - singleton_VideoProjectM := TVideoPlayback_ProjectM.create(); - AudioManager.add( singleton_VideoProjectM ); - -finalization - AudioManager.Remove( singleton_VideoProjectM ); - - - -end. +{############################################################################ +# Visualizer support for UltraStar deluxe # +# # +# Created by hennymcc # +# Slight modifications by Jay Binks # +# based on UVideo.pas # +#############################################################################} + +unit UVisualizer; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphicClasses, + textgl, + math, + OpenGL12, + SysUtils, + UIni, + {$ifdef DebugDisplay} + {$ifdef win32} + dialogs, + {$endif} + {$endif} + projectM, + UMusic; + +implementation + +uses + UGraphic, + ULog; + +var + singleton_VideoProjectM : IVideoPlayback; + +const + gx = 32; + gy = 24; + fps = 30; + texsize = 512; + visualsDir = 'Visuals'; // TODO: move this to a place common for all visualizers + projectMDir = visualsDir+'/projectM'; + presetsDir = projectMDir+'/presets'; + fontsDir = projectMDir+'/fonts'; + +type + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) + private + pm : TProjectM; + + VisualizerStarted , + VisualizerPaused : Boolean; + + VisualTex : glUint; + PCMData : TPCMData; + hRC : Integer; + hDC : Integer; + + RndPCMcount : integer; + + projMatrix: array[0..3, 0..3] of GLdouble; + texMatrix: array[0..3, 0..3] of GLdouble; + + procedure VisualizerStart; + procedure VisualizerStop; + + procedure VisualizerTogglePause; + + function GetRandomPCMData(var data: TPCMData): Cardinal; + + procedure SaveOpenGLState(); + procedure RestoreOpenGLState(); + + public + constructor create(); + procedure init(); + function GetName: String; + + function Open( aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure MoveTo(Time: real); + function getPosition: real; + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + end; + + +constructor TVideoPlayback_ProjectM.create(); +begin + RndPCMcount := 0; +end; + + +procedure TVideoPlayback_ProjectM.init(); +begin + VisualizerStarted := False; + VisualizerPaused := False; + + {$IFDEF UseTexture} + glGenTextures(1, PglUint(@VisualTex)); + glBindTexture(GL_TEXTURE_2D, VisualTex); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + {$ENDIF} +end; + +function TVideoPlayback_ProjectM.GetName: String; +begin + result := 'ProjectM'; +end; + + +function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed +begin + VisualizerStart(); + result := true; +end; + +procedure TVideoPlayback_ProjectM.Close; +begin +end; + +procedure TVideoPlayback_ProjectM.Play; +begin + VisualizerStart(); +end; + +procedure TVideoPlayback_ProjectM.Pause; +begin + VisualizerTogglePause(); +end; + +procedure TVideoPlayback_ProjectM.Stop; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.MoveTo(Time: real); +begin + pm.RandomPreset(); +end; + +function TVideoPlayback_ProjectM.getPosition: real; +begin + result := 0; +end; + +procedure TVideoPlayback_ProjectM.SaveOpenGLState(); +begin + // save all OpenGL state-machine attributes + glPushAttrib(GL_ALL_ATTRIB_BITS); + + // save projection-matrix + glMatrixMode(GL_PROJECTION); + // - WARNING: projection-matrix stack-depth is only 2! + // -> overflow might occur if glPopMatrix() is used for this matrix + // -> use glGet() instead of glPushMatrix() + glPushMatrix(); + //glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix); + + // save texture-matrix + glMatrixMode(GL_TEXTURE); + // - WARNING: texture-matrix stack-depth is only 2! + // -> overflow might occur if glPopMatrix() is used for this matrix + // -> use glGet() instead of glPushMatrix() if problems appear + glPushMatrix(); + //glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix); + + // save modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); +end; + +procedure TVideoPlayback_ProjectM.RestoreOpenGLState(); +begin + // restore projection-matrix + glMatrixMode(GL_PROJECTION); + // - WARNING: projection-matrix stack-depth is only 2! + // -> overflow _occurs_ if glPopMatrix() is used for this matrix + // -> use glLoadMatrix() instead of glPopMatrix() + glPopMatrix(); + //glLoadMatrixd(@projMatrix); + + // restore texture-matrix + // -> overflow might occur if glPopMatrix() is used for this matrix + glMatrixMode(GL_TEXTURE); + glPopMatrix(); + //glLoadMatrixd(@texMatrix); + + // restore modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + + // restore all OpenGL state-machine attributes + glPopAttrib(); +end; + +procedure TVideoPlayback_ProjectM.VisualizerStart; +var + initResult: Cardinal; +begin + VisualizerStarted := True; + + pm := TProjectM.Create(gx, gy, fps, texsize, ScreenW, ScreenH, + presetsDir, fontsDir); + //initResult := projectM_initRenderToTexture(pm); + + SaveOpenGLState(); + pm.ResetGL(ScreenW, ScreenH); + RestoreOpenGLState(); +end; + +procedure TVideoPlayback_ProjectM.VisualizerStop; +begin + if VisualizerStarted then begin + VisualizerStarted := False; + pm.Free(); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerTogglePause; +begin + VisualizerPaused := not VisualizerPaused; +end; + +procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); +var + i: integer; + nSamples: cardinal; + stackDepth: Integer; +begin + if not VisualizerStarted then Exit; + if VisualizerPaused then Exit; + + // get audio data + nSamples := AudioPlayback.GetPCMData(PcmData); + + if nSamples = 0 then + nSamples := GetRandomPCMData(PcmData); + + pm.AddPCM16Data(PSmallint(@PcmData), nSamples); + + // store OpenGL state (might be messed up otherwise) + SaveOpenGLState(); + pm.ResetGL(ScreenW, ScreenH); + + //glGetIntegerv(GL_PROJECTION_STACK_DEPTH, @stackDepth); + //writeln('StackDepth0: ' + inttostr(stackDepth)); + + // let projectM render a frame + try + pm.RenderFrame(); + except + // this may happen with some presets ( on linux ) if there is a div by zero + // in projectM's getBeatVals() function (file: beat_detect.cc) + Log.LogStatus('Div by zero!', 'Visualizer'); + MoveTo( now ); + end; + + //glGetIntegerv(GL_PROJECTION_STACK_DEPTH, @stackDepth); + //writeln('StackDepth1: ' + inttostr(stackDepth)); + + {$IFDEF UseTexture} + glBindTexture(GL_TEXTURE_2D, VisualTex); + glFlush(); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); + {$ENDIF} + + // restore USDX OpenGL state + RestoreOpenGLState(); + + // discard projectM's depth buffer information (avoid overlay) + glClear(GL_DEPTH_BUFFER_BIT); +end; + +procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); +begin + {$IFDEF UseTexture} + // 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 VisualizerStarted then Exit; + + // setup display + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glLoadIdentity(); + gluOrtho2D(0, 1, 0, 1); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glLoadIdentity(); + + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glColor4f(1, 1, 1, 1); + + // draw projectM frame + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(1, 0); glVertex2f(1, 0); + glTexCoord2f(1, 1); glVertex2f(1, 1); + glTexCoord2f(0, 1); glVertex2f(0, 1); + glEnd(); + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // restore state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + {$ENDIF} +end; + +function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; +var + i: integer; +begin + // Produce some fake PCM data + if ( RndPCMcount mod 500 = 0 ) then + begin + for i := 0 to 511 do begin + data[0][i] := 0; + data[1][i] := 0; + end; + end + else begin + for i := 0 to 511 do begin + if ( i mod 2 = 0 ) then begin + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end + else begin; + data[0][i] := floor(Random * power(2.,14)); + data[1][i] := floor(Random * power(2.,14)); + end; + if ( i mod 2 = 1 ) then begin + data[0][i] := -data[0][i]; + data[1][i] := -data[1][i]; + end; + end; + end; + Inc( RndPCMcount ); + result := 512; +end; + + +initialization + singleton_VideoProjectM := TVideoPlayback_ProjectM.create(); + AudioManager.add( singleton_VideoProjectM ); + +finalization + AudioManager.Remove( singleton_VideoProjectM ); + + + +end. -- cgit v1.2.3 From 96407b5adf8eb1b9ff5e3838a70158d7d3aa29fd Mon Sep 17 00:00:00 2001 From: b1indy Date: Mon, 17 Dec 2007 17:52:42 +0000 Subject: swscale experiment was not satisfying (bad performance), but made clear, that there was unnecessary copying done in GetFrame. UVideo.pas will need some more cleanup but should work better than before. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@717 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 81 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 65 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 94c8d7ab..42971daf 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -14,7 +14,6 @@ unit UVideo; //{$define DebugFrames} //{$define Info} - interface {$IFDEF FPC} @@ -38,6 +37,7 @@ uses SDL, avcodec, avformat, avutil, +// swscale, math, OpenGL12, SysUtils, @@ -50,7 +50,8 @@ uses SDL, UAudio_FFMpeg, {$endif} UIni, - UMusic; + UMusic, + UGraphic; var @@ -65,6 +66,7 @@ type fVideoTex : glUint; fVideoSkipTime : Single; + //remove fTexData : array of Byte; VideoFormatContext: PAVFormatContext; @@ -77,6 +79,8 @@ type AVFrameRGB: PAVFrame; myBuffer: pByte; +// SoftwareScaleContext: PSwsContext; + TexX, TexY, dataX, dataY: Cardinal; ScaledVideoWidth, ScaledVideoHeight: Real; @@ -107,13 +111,13 @@ type function getPosition: real; procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); + procedure DrawGL(Screen: integer); end; const SDL_AUDIO_BUFFER_SIZE = 1024; - + {$ifdef DebugDisplay} //{$ifNdef win32} @@ -165,7 +169,7 @@ begin begin writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); st := aFormatCtx.streams[i]; - + if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND (aFirstVideoStream < 0) THEN begin @@ -177,10 +181,10 @@ begin begin aFirstAudioStream := i; end; - + inc( i ); end; // while - + result := (aFirstAudioStream > -1) OR (aFirstVideoStream > -1) ; // Didn't find a video stream end; @@ -327,10 +331,22 @@ begin PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, VideoCodecContext^.width, VideoCodecContext^.height); //errnum:=1; - +{ + writeln('swscontext->srcH='+inttostr(SoftwareScaleContext^.srcH)); + writeln('swscontext->dstH='+inttostr(SoftwareScaleContext^.dstH)); + writeln('swscontext->slicedir='+inttostr(SoftwareScaleContext^.slicedir)); + errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize), + 0,VideoCodecContext^.Height, + @(AVFrameRGB.data),@(AVFrameRGB.linesize)); + writeln('errnum='+inttostr(errnum)); +} if errnum >=0 then begin - // copy RGB pixeldata to our TextureBuffer + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +(* // copy RGB pixeldata to our TextureBuffer // (line by line) FrameDataPtr := pointer( AVFrameRGB^.data[0] ); @@ -345,6 +361,7 @@ begin glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, fTexData); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +*) {$ifdef DebugFrames} //frame decode debug display GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); @@ -436,6 +453,8 @@ var spec : TSDL_AudioSpec; aCodec : pAVCodec; + sws_dst_w, sws_dst_h: Integer; + begin fVideoOpened := False; fVideoPaused := False; @@ -474,7 +493,7 @@ begin if( av_find_stream_info(VideoFormatContext) >= 0 ) then begin find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); - + writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); end; @@ -541,7 +560,7 @@ begin Exit; end; - + if(VideoCodec<>Nil) then begin errnum:=avcodec_open(VideoCodecContext, VideoCodec); @@ -555,6 +574,13 @@ begin end; if(errnum >=0) then begin + if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then + begin + ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; {$ifdef DebugDisplay} showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ @@ -565,24 +591,47 @@ begin AVFrame:=avcodec_alloc_frame; AVFrameRGB:=avcodec_alloc_frame; end; + + dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); + dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); myBuffer:=Nil; if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then begin - myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, - VideoCodecContext^.height)); + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY)); +// myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, VideoCodecContext^.height)); end; if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, - VideoCodecContext^.width, VideoCodecContext^.height) +// VideoCodecContext^.width, VideoCodecContext^.height) + dataX, dataY) else begin -{$ifdef DebugDisplay} + {$ifdef DebugDisplay} showmessage('failed to allocate video buffer'); -{$endif} + {$endif} av_free(AVFrameRGB); av_free(AVFrame); avcodec_close(VideoCodecContext); av_close_input_file(VideoFormatContext); Exit; end; +{ + writeln('trying to get sws context: '+inttostr(VideoCodecContext^.width)+'x'+ + inttostr(VideoCodecContext^.height)+' -> '+inttostr(dataX)+'x'+inttostr(dataY)); + SoftwareScaleContext:=Nil; + SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), + dataX, dataY, integer(PIX_FMT_RGB24), + SWS_FAST_BILINEAR, 0, 0, 0); + if SoftwareScaleContext <> Nil then + writeln('got swscale context') + else begin + writeln('ERROR: didn´t get swscale context'); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; +} + // this is the errnum from avpicture_fill if errnum >=0 then begin fVideoOpened:=True; -- cgit v1.2.3 From bbda88716432ec68fd686438d291b41f918dc4af Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Dec 2007 02:25:24 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@719 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index b97408d4..18bed197 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -358,8 +358,11 @@ begin //------------------------------ //Finish Application //------------------------------ - if Ini.LPT = 1 then LCD.Clear; - if Ini.LPT = 2 then Light.TurnOff; + + {$ifdef WIN32} + if Ini.LPT = 1 then LCD.Clear; + if Ini.LPT = 2 then Light.TurnOff; + {$endif} Log.LogStatus('Main Loop', 'Finished'); Log.Free; -- cgit v1.2.3 From 070bdf48932aa39e048ed645d6c5ad1a9eaf1309 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Dec 2007 02:35:14 +0000 Subject: fixed file name error git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@720 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index f050eaea..c3a7228b 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -262,9 +262,9 @@ begin av_register_all(); SDL_Init(SDL_INIT_AUDIO); - StartSoundStream := LoadSoundFromFile(SoundPath + 'Common Start.mp3'); + StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); { - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common back.mp3'); SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); -- cgit v1.2.3 From 19903a5497d2a4468280cab56b0cac71207e3c03 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Dec 2007 03:36:28 +0000 Subject: fixed ffmpeg-sdl_audio playback still only got noise.. but it works on linux git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@721 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 42 ++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 14 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index c3a7228b..8cef934b 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -478,8 +478,10 @@ begin if (buffer = nil) then exit; + while true do begin + while (audio_pkt_size > 0) do begin // writeln( 'got audio packet' ); @@ -489,7 +491,7 @@ begin len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), data_size, audio_pkt_data, audio_pkt_size); - writeln('avcodec_decode_audio : ' + inttostr( len1 )); +// writeln('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin @@ -516,6 +518,8 @@ begin if (pkt.data <> nil) then av_free_packet(pkt); + + if (packetQueue.quit) then begin result := -1; @@ -528,10 +532,12 @@ begin exit; end; + audio_pkt_data := PChar(pkt.data); audio_pkt_size := pkt.size; // writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); end; + end; procedure AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; @@ -544,19 +550,21 @@ begin outStream := TFFMpegOutputStream(userdata); while (len > 0) do - with outStream do begin + with outStream do + begin + if (audio_buf_index >= audio_buf_size) then begin // We have already sent all our data; get more audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - writeln('audio_decode_frame : '+ inttostr(audio_size)); +// writeln('audio_decode_frame : '+ inttostr(audio_size)); if(audio_size < 0) then begin // If error, output silence audio_buf_size := 1024; FillChar(audio_buf, audio_buf_size, #0); - writeln( 'Silence' ); +// writeln( 'Silence' ); end else begin @@ -579,7 +587,9 @@ begin Dec(len, len1); Inc(stream, len1); Inc(audio_buf_index, len1); + end; + end; function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; @@ -616,7 +626,7 @@ begin while (av_read_frame(stream.pFormatCtx, packet) >= 0) do begin - writeln( 'ffmpeg - av_read_frame' ); +// writeln( 'ffmpeg - av_read_frame' ); if (packet.stream_index = stream.ffmpegStreamID) then begin @@ -627,9 +637,10 @@ begin begin av_free_packet(packet); end; + end; - Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); +// Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); result := 0; end; @@ -779,6 +790,7 @@ function TPacketQueue.Put(pkt : PAVPacket): integer; var pkt1 : PAVPacketList; begin + result := -1; if (av_dup_packet(pkt) < 0) then @@ -793,7 +805,7 @@ begin SDL_LockMutex(Self.mutex); - try +// try if (Self.lastPkt = nil) then Self.firstPkt := pkt1 @@ -803,14 +815,14 @@ begin Self.lastPkt := pkt1; inc(Self.nbPackets); - Writeln('Put: ' + inttostr(nbPackets)); +// Writeln('Put: ' + inttostr(nbPackets)); Self.size := Self.size + pkt1^.pkt.size; SDL_CondSignal(Self.cond); - finally +// finally SDL_UnlockMutex(Self.mutex); - end; +// end; result := 0; end; @@ -819,10 +831,11 @@ function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; var pkt1 : PAVPacketList; begin + result := -1; SDL_LockMutex(Self.mutex); - try +// try while true do begin if (quit) then @@ -837,7 +850,7 @@ begin Self.lastPkt := nil; dec(Self.nbPackets); - Writeln('Get: ' + inttostr(nbPackets)); +// Writeln('Get: ' + inttostr(nbPackets)); Self.size := Self.size - pkt1^.pkt.size; pkt := pkt1^.pkt; @@ -857,9 +870,10 @@ begin SDL_CondWait(Self.cond, Self.mutex); end; end; - finally +// finally SDL_UnlockMutex(Self.mutex); - end; +// end; + end; -- cgit v1.2.3 From c7e01792aaf8f16bb17d7254d93157d617271391 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Dec 2007 03:51:24 +0000 Subject: fixed crash on song play, if the AudioInterface reports the song as 0 length. fixed ffmpeg bug with song length. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@722 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 8cef934b..9a242cd9 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -375,37 +375,33 @@ function TAudio_FFMpeg.Length: real; var bytes: integer; begin - Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; + Result := 0; + // Todo : why is Music stream always nil !? + + if assigned( MusicStream ) then + begin + //writeln( 'MusicStream : ' + inttostr( integer( assigned( MusicStream ))) ); + //writeln( 'MusicStream.pFormatCtx : ' + inttostr( integer( assigned( MusicStream.pFormatCtx ))) ); + //writeln( 'MusicStream.pFormatCtx^.duration : ' + inttostr( integer( MusicStream.pFormatCtx^.duration )) ); + + Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; + end; end; function TAudio_FFMpeg.getPosition: real; -var - bytes: integer; begin Result := 0; - -(* - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -*) end; function TAudio_FFMpeg.Finished: boolean; begin Result := false; - -(* - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -*) end; procedure TAudio_FFMpeg.PlayStart; begin if StartSoundStream <> nil then - StartSoundStream.Play(); + StartSoundStream.Play(); end; procedure TAudio_FFMpeg.PlayBack; -- cgit v1.2.3 From d31df89c2c152567cdb35bc695f33d131ea885b7 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 04:35:24 +0000 Subject: non_working with portaudio-support git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@723 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg_Pa.pas | 969 +++++++++++++++++++++++++++++++++ 1 file changed, 969 insertions(+) create mode 100644 Game/Code/Classes/UAudio_FFMpeg_Pa.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas new file mode 100644 index 00000000..a1682e78 --- /dev/null +++ b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas @@ -0,0 +1,969 @@ +unit UAudio_FFMpeg; + +(******************************************************************************* + +This unit is primarily based upon - + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + + and tutorial03.c + + http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*******************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + SDL, // Used for Audio output Interface + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + //libc, // not available in win32 + {$ENDIF} + portaudio, + UIni, + UMain, + UThemes; + + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + firstPkt, + lastPkt : PAVPacketList; + nbPackets : integer; + size : integer; + mutex : PSDL_Mutex; + cond : PSDL_Cond; + quit : boolean; + + public + constructor Create(); + + function Put(pkt : PAVPacket): integer; + function Get(var pkt: TAVPacket; block: boolean): integer; + end; + +type + TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); + +const + StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); + +type + PAudioBuffer = ^TAudioBuffer; + TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; + +const + SDL_AUDIO_BUFFER_SIZE = 1024; + +type + TFFMpegOutputStream = class(TAudioOutputStream) + private + parseThread: PSDL_Thread; + packetQueue: TPacketQueue; + + status: TStreamStatus; + + // FFMpeg internal data + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + + // static vars for AudioDecodeFrame + pkt : TAVPacket; + audio_pkt_data : PChar; + audio_pkt_size : integer; + + // static vars for AudioCallback + audio_buf_index : cardinal; + audio_buf_size : cardinal; + audio_buf : TAudioBuffer; + + channel: PPaStream; + public + constructor Create(); overload; + constructor Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; + + procedure Play(); + procedure Pause(); + procedure Stop(); + procedure Close(); + + function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; + end; + +type + TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) + private + MusicStream: TFFMpegOutputStream; + + StartSoundStream: TFFMpegOutputStream; + BackSoundStream: TFFMpegOutputStream; + SwooshSoundStream: TFFMpegOutputStream; + ChangeSoundStream: TFFMpegOutputStream; + OptionSoundStream: TFFMpegOutputStream; + ClickSoundStream: TFFMpegOutputStream; + DrumSoundStream: TFFMpegOutputStream; + HihatSoundStream: TFFMpegOutputStream; + ClapSoundStream: TFFMpegOutputStream; + ShuffleSoundStream: TFFMpegOutputStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + + function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; + public + function GetName: String; + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function getPosition: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + function LoadSoundFromFile(Name: string): TFFMpegOutputStream; + + //Equalizer + function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + end; + +var + test: TFFMpegOutputStream; + it: integer; + +var + singleton_MusicFFMpeg : IAudioPlayback = nil; + + +function ParseAudio(data: Pointer): integer; cdecl; forward; +procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; forward; + +constructor TFFMpegOutputStream.Create(); +begin + inherited; + + packetQueue := TPacketQueue.Create(); + + FillChar(pkt, sizeof(TAVPacket), #0); + + status := sStopped; + + audio_pkt_data := nil; + audio_pkt_size := 0; + + audio_buf_index := 0; + audio_buf_size := 0; +end; + +constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); +begin + Create(); + + Self.pFormatCtx := pFormatCtx; + Self.pCodecCtx := pCodecCtx; + Self.pCodec := pCodec; + Self.ffmpegStreamID := ffmpegStreamID; + Self.ffmpegStream := ffmpegStream; + + test := Self; + it:=0; +end; + +procedure TFFMpegOutputStream.Play(); +var + err: TPaError; +begin + writeln('Play request'); + if(status = sStopped) then + begin + writeln('Play ok'); + status := sPlaying; + Self.parseThread := SDL_CreateThread(@ParseAudio, Self); + //SDL_PauseAudio(0); + + err := Pa_StartStream(Self.channel); + end; +end; + +procedure TFFMpegOutputStream.Pause(); +begin +end; + +procedure TFFMpegOutputStream.Stop(); +begin +end; + +procedure TFFMpegOutputStream.Close(); +begin + // Close the codec + avcodec_close(pCodecCtx); + + // Close the video file + av_close_input_file(pFormatCtx); +end; + + +function TAudio_FFMpeg.GetName: String; +begin + result := 'FFMpeg'; +end; + +procedure TAudio_FFMpeg.InitializePlayback; +begin + Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); + + Loaded := false; + Loop := false; + + av_register_all(); + //SDL_Init(SDL_INIT_AUDIO); + Pa_Initialize(); + + StartSoundStream := LoadSoundFromFile(SoundPath + 'Common Start.mp3'); + { + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); + SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); + ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); + OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); + ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); + } +// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); +// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); +// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); + +// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); +end; + + +procedure TAudio_FFMpeg.SetVolume(Volume: integer); +begin + //New: Sets Volume only for this Application +(* + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +*) +end; + +procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume +// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_FFMpeg.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin +// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_FFMpeg.Rewind; +begin + if Loaded then + begin + end; +end; + +procedure TAudio_FFMpeg.MoveTo(Time: real); +var + bytes: integer; +begin +// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); +// BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_FFMpeg.Play; +begin + if MusicStream <> nil then + if Loaded then + begin + if Loop then + begin + end; + // start from beginning... + // actually bass itself does not loop, nor does this TAudio_FFMpeg Class + MusicStream.Play(); + end; +end; + +procedure TAudio_FFMpeg.Pause; //Pause Mod +begin + if MusicStream <> nil then + if Loaded then begin + MusicStream.Pause(); // Pauses Song + end; +end; + +procedure TAudio_FFMpeg.Stop; +begin + if MusicStream <> nil then + MusicStream.Stop(); +end; + +procedure TAudio_FFMpeg.Close; +begin + if MusicStream <> nil then + MusicStream.Close(); +end; + +function TAudio_FFMpeg.Length: real; +var + bytes: integer; +begin + Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; +end; + +function TAudio_FFMpeg.getPosition: real; +var + bytes: integer; +begin + Result := 0; + +(* + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +*) +end; + +function TAudio_FFMpeg.Finished: boolean; +begin + Result := false; + +(* + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +*) +end; + +procedure TAudio_FFMpeg.PlayStart; +begin + if StartSoundStream <> nil then + StartSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayBack; +begin + if BackSoundStream <> nil then + BackSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlaySwoosh; +begin + if SwooshSoundStream <> nil then + SwooshSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayChange; +begin + if ChangeSoundStream <> nil then + ChangeSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayOption; +begin + if OptionSoundStream <> nil then + OptionSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayClick; +begin + if ClickSoundStream <> nil then + ClickSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayDrum; +begin + if DrumSoundStream <> nil then + DrumSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayHihat; +begin + if HihatSoundStream <> nil then + HihatSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayClap; +begin + if ClapSoundStream <> nil then + ClapSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.StopShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Stop(); +end; + + +function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; +var + len1, + data_size: integer; +begin + result := -1; + + if (buffer = nil) then + exit; + + while true do + begin + while (audio_pkt_size > 0) do + begin +// writeln( 'got audio packet' ); + data_size := bufSize; + + if(pCodecCtx = nil) then begin + writeln('Das wars'); + exit; + end; + + // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), + data_size, audio_pkt_data, audio_pkt_size); + + //writeln('avcodec_decode_audio : ' + inttostr( len1 )); + + if(len1 < 0) then + begin + // if error, skip frame +// writeln( 'Skip audio frame' ); + audio_pkt_size := 0; + break; + end; + + audio_pkt_data := audio_pkt_data + len1; + audio_pkt_size := audio_pkt_size + len1; + + if (data_size <= 0) then + begin + // No data yet, get more frames + continue; + end; + + // We have data, return it and come back for more later + result := data_size; + exit; + end; + + inc(it); + if (pkt.data <> nil) then + begin + av_free_packet(pkt); + end; + + if (packetQueue.quit) then + begin + result := -1; + exit; + end; + writeln(it); + if (packetQueue.Get(pkt, true) < 0) then + begin + result := -1; + exit; + end; + + audio_pkt_data := PChar(pkt.data); + audio_pkt_size := pkt.size; +// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + end; +end; + +procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; +var + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; +begin + outStream := TFFMpegOutputStream(userdata); + + while (len > 0) do + with outStream do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(stream, pSrc , len1); + {$else} + memcpy(stream, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(stream, len1); + Inc(audio_buf_index, len1); + end; +end; + +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; + len : integer; +begin + outStream := TFFMpegOutputStream(userData); + len := frameCount * 4; // use *2 for mono-files + + while (len > 0) do + with outStream do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(output, pSrc , len1); + {$else} + memcpy(output, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(PChar(output), len1); + Inc(audio_buf_index, len1); + end; +end; + +function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; +var + i : integer; + streamID: integer; + stream : PAVStream; +begin + // Find the first audio stream + streamID := -1; + + for i := 0 to pFormatCtx^.nb_streams-1 do + begin + //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); + stream := pFormatCtx^.streams[i]; + + if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then + begin + Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); + streamID := i; + break; + end; + end; + + result := streamID; +end; + +function ParseAudio(data: Pointer): integer; cdecl; +var + packet: TAVPacket; + stream: TFFMpegOutputStream; +begin + stream := TFFMpegOutputStream(data); + + while (av_read_frame(stream.pFormatCtx, packet) >= 0) do + begin + //writeln( 'ffmpeg - av_read_frame' ); + + if (packet.stream_index = stream.ffmpegStreamID) then + begin + //writeln( 'packet_queue_put' ); + stream.packetQueue.put(@packet); + end + else + begin + av_free_packet(packet); + end; + end; + + //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); + + result := 0; +end; + + +function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; +var + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + wanted_spec, + spec : TSDL_AudioSpec; + csIndex : integer; + stream : TFFMpegOutputStream; + err : TPaError; +begin + result := nil; + + if (not FileExists(Name)) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); + exit; + end; + + // Open audio file + if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then + exit; + + // Retrieve stream information + if (av_find_stream_info(pFormatCtx) < 0) then + exit; + + dump_format(pFormatCtx, 0, pchar(Name), 0); + + ffmpegStreamID := FindAudioStreamID(pFormatCtx); + if (ffmpegStreamID < 0) then + exit; + + //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + + ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; + pCodecCtx := ffmpegStream^.codec; + + pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); + if (pCodec = nil) then + begin + Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); + exit; + end; + + avcodec_open(pCodecCtx, pCodec); + //writeln( 'Opened the codec' ); + + stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, + ffmpegStreamID, ffmpegStream); + + { + // Set SDL audio settings from codec info + wanted_spec.freq := pCodecCtx^.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := pCodecCtx^.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := AudioCallback; + wanted_spec.userdata := stream; + + // TODO: this works only one time (?) + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); + stream.Free(); + exit; + end; + } + + err := Pa_OpenDefaultStream(stream.channel, 0, pCodecCtx^.channels, paInt16, + pCodecCtx^.sample_rate, SDL_AUDIO_BUFFER_SIZE div 4, //paFramesPerBufferUnspecified, + @PA_AudioCallback, stream); + if(err <> paNoError) then begin + Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); + stream.Free(); + exit; + end; + + Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); + + //Add CustomSound + csIndex := High(CustomSounds) + 1; + SetLength (CustomSounds, csIndex + 1); + CustomSounds[csIndex].Filename := Name; + CustomSounds[csIndex].Stream := stream; + + result := stream; +end; + +//Equalizer +function TAudio_FFMpeg.GetFFTData: TFFTData; +var + data: TFFTData; +begin + //Get Channel Data Mono and 256 Values +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + result := data; +end; + +// Interface for Visualizer +function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + +function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; +var + S: TFFMpegOutputStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + S := LoadSoundFromFile(SoundPath + Filename); + if (S <> nil) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); +end; + + +constructor TPacketQueue.Create(); +begin + inherited; + + firstPkt := nil; + lastPkt := nil; + nbPackets := 0; + size := 0; + + mutex := SDL_CreateMutex(); + cond := SDL_CreateCond(); +end; + +function TPacketQueue.Put(pkt : PAVPacket): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + if (av_dup_packet(pkt) < 0) then + exit; + + pkt1 := av_malloc(sizeof(TAVPacketList)); + if (pkt1 = nil) then + exit; + + pkt1^.pkt := pkt^; + pkt1^.next := nil; + + + SDL_LockMutex(Self.mutex); + try + + if (Self.lastPkt = nil) then + Self.firstPkt := pkt1 + else + Self.lastPkt^.next := pkt1; + + Self.lastPkt := pkt1; + inc(Self.nbPackets); + + Writeln('Put: ' + inttostr(nbPackets)); + + Self.size := Self.size + pkt1^.pkt.size; + SDL_CondSignal(Self.cond); + + finally + SDL_UnlockMutex(Self.mutex); + end; + + result := 0; +end; + +function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + SDL_LockMutex(Self.mutex); + try + while true do + begin + if (quit) then + exit; + + pkt1 := Self.firstPkt; + + if (pkt1 <> nil) then + begin + Self.firstPkt := pkt1.next; + if (Self.firstPkt = nil) then + Self.lastPkt := nil; + dec(Self.nbPackets); + + Writeln('Get: ' + inttostr(nbPackets)); + + Self.size := Self.size - pkt1^.pkt.size; + pkt := pkt1^.pkt; + av_free(pkt1); + + result := 1; + break; + end + else + if (not block) then + begin + result := 0; + break; + end + else + begin + SDL_CondWait(Self.cond, Self.mutex); + end; + end; + finally + SDL_UnlockMutex(Self.mutex); + end; +end; + + + +initialization + singleton_MusicFFMpeg := TAudio_FFMpeg.create(); + + writeln( 'UAudio_FFMpeg - Register Playback' ); + AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); + +finalization + AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); + + +end. -- cgit v1.2.3 From b45a6fc256e832532fa491e1fd1f5ba7d09f011e Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 04:56:10 +0000 Subject: added audio-callback return value git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@724 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg_Pa.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas index a1682e78..55ef347a 100644 --- a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas +++ b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas @@ -660,6 +660,8 @@ begin Inc(PChar(output), len1); Inc(audio_buf_index, len1); end; + + result := paContinue; end; function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; -- cgit v1.2.3 From 518fc523189641a8434536a7665b802157b95799 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Dec 2007 05:11:54 +0000 Subject: fixed to make compile on linux git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@725 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg_Pa.pas | 1951 ++++++++++++++++---------------- 1 file changed, 980 insertions(+), 971 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas index 55ef347a..400af7ce 100644 --- a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas +++ b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas @@ -1,971 +1,980 @@ -unit UAudio_FFMpeg; - -(******************************************************************************* - -This unit is primarily based upon - - http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - - and tutorial03.c - - http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - SDL, // Used for Audio output Interface - avcodec, // FFMpeg Audio file decoding - avformat, - avutil, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - //libc, // not available in win32 - {$ENDIF} - portaudio, - UIni, - UMain, - UThemes; - - -type - PPacketQueue = ^TPacketQueue; - TPacketQueue = class - private - firstPkt, - lastPkt : PAVPacketList; - nbPackets : integer; - size : integer; - mutex : PSDL_Mutex; - cond : PSDL_Cond; - quit : boolean; - - public - constructor Create(); - - function Put(pkt : PAVPacket): integer; - function Get(var pkt: TAVPacket; block: boolean): integer; - end; - -type - TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); - -const - StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); - -type - PAudioBuffer = ^TAudioBuffer; - TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; - -const - SDL_AUDIO_BUFFER_SIZE = 1024; - -type - TFFMpegOutputStream = class(TAudioOutputStream) - private - parseThread: PSDL_Thread; - packetQueue: TPacketQueue; - - status: TStreamStatus; - - // FFMpeg internal data - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - - // static vars for AudioDecodeFrame - pkt : TAVPacket; - audio_pkt_data : PChar; - audio_pkt_size : integer; - - // static vars for AudioCallback - audio_buf_index : cardinal; - audio_buf_size : cardinal; - audio_buf : TAudioBuffer; - - channel: PPaStream; - public - constructor Create(); overload; - constructor Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; - - procedure Play(); - procedure Pause(); - procedure Stop(); - procedure Close(); - - function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; - end; - -type - TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) - private - MusicStream: TFFMpegOutputStream; - - StartSoundStream: TFFMpegOutputStream; - BackSoundStream: TFFMpegOutputStream; - SwooshSoundStream: TFFMpegOutputStream; - ChangeSoundStream: TFFMpegOutputStream; - OptionSoundStream: TFFMpegOutputStream; - ClickSoundStream: TFFMpegOutputStream; - DrumSoundStream: TFFMpegOutputStream; - HihatSoundStream: TFFMpegOutputStream; - ClapSoundStream: TFFMpegOutputStream; - ShuffleSoundStream: TFFMpegOutputStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; - public - function GetName: String; - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(Name: string): TFFMpegOutputStream; - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - end; - -var - test: TFFMpegOutputStream; - it: integer; - -var - singleton_MusicFFMpeg : IAudioPlayback = nil; - - -function ParseAudio(data: Pointer): integer; cdecl; forward; -procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; forward; - -constructor TFFMpegOutputStream.Create(); -begin - inherited; - - packetQueue := TPacketQueue.Create(); - - FillChar(pkt, sizeof(TAVPacket), #0); - - status := sStopped; - - audio_pkt_data := nil; - audio_pkt_size := 0; - - audio_buf_index := 0; - audio_buf_size := 0; -end; - -constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); -begin - Create(); - - Self.pFormatCtx := pFormatCtx; - Self.pCodecCtx := pCodecCtx; - Self.pCodec := pCodec; - Self.ffmpegStreamID := ffmpegStreamID; - Self.ffmpegStream := ffmpegStream; - - test := Self; - it:=0; -end; - -procedure TFFMpegOutputStream.Play(); -var - err: TPaError; -begin - writeln('Play request'); - if(status = sStopped) then - begin - writeln('Play ok'); - status := sPlaying; - Self.parseThread := SDL_CreateThread(@ParseAudio, Self); - //SDL_PauseAudio(0); - - err := Pa_StartStream(Self.channel); - end; -end; - -procedure TFFMpegOutputStream.Pause(); -begin -end; - -procedure TFFMpegOutputStream.Stop(); -begin -end; - -procedure TFFMpegOutputStream.Close(); -begin - // Close the codec - avcodec_close(pCodecCtx); - - // Close the video file - av_close_input_file(pFormatCtx); -end; - - -function TAudio_FFMpeg.GetName: String; -begin - result := 'FFMpeg'; -end; - -procedure TAudio_FFMpeg.InitializePlayback; -begin - Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); - - Loaded := false; - Loop := false; - - av_register_all(); - //SDL_Init(SDL_INIT_AUDIO); - Pa_Initialize(); - - StartSoundStream := LoadSoundFromFile(SoundPath + 'Common Start.mp3'); - { - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); - SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); - ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); - OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); - ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); - } -// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); -// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); -// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); - -// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); -end; - - -procedure TAudio_FFMpeg.SetVolume(Volume: integer); -begin - //New: Sets Volume only for this Application -(* - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -*) -end; - -procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume -// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_FFMpeg.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin -// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_FFMpeg.Rewind; -begin - if Loaded then - begin - end; -end; - -procedure TAudio_FFMpeg.MoveTo(Time: real); -var - bytes: integer; -begin -// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); -// BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TAudio_FFMpeg.Play; -begin - if MusicStream <> nil then - if Loaded then - begin - if Loop then - begin - end; - // start from beginning... - // actually bass itself does not loop, nor does this TAudio_FFMpeg Class - MusicStream.Play(); - end; -end; - -procedure TAudio_FFMpeg.Pause; //Pause Mod -begin - if MusicStream <> nil then - if Loaded then begin - MusicStream.Pause(); // Pauses Song - end; -end; - -procedure TAudio_FFMpeg.Stop; -begin - if MusicStream <> nil then - MusicStream.Stop(); -end; - -procedure TAudio_FFMpeg.Close; -begin - if MusicStream <> nil then - MusicStream.Close(); -end; - -function TAudio_FFMpeg.Length: real; -var - bytes: integer; -begin - Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; -end; - -function TAudio_FFMpeg.getPosition: real; -var - bytes: integer; -begin - Result := 0; - -(* - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -*) -end; - -function TAudio_FFMpeg.Finished: boolean; -begin - Result := false; - -(* - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -*) -end; - -procedure TAudio_FFMpeg.PlayStart; -begin - if StartSoundStream <> nil then - StartSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayBack; -begin - if BackSoundStream <> nil then - BackSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlaySwoosh; -begin - if SwooshSoundStream <> nil then - SwooshSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayChange; -begin - if ChangeSoundStream <> nil then - ChangeSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayOption; -begin - if OptionSoundStream <> nil then - OptionSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClick; -begin - if ClickSoundStream <> nil then - ClickSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayDrum; -begin - if DrumSoundStream <> nil then - DrumSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayHihat; -begin - if HihatSoundStream <> nil then - HihatSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClap; -begin - if ClapSoundStream <> nil then - ClapSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.StopShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Stop(); -end; - - -function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; -var - len1, - data_size: integer; -begin - result := -1; - - if (buffer = nil) then - exit; - - while true do - begin - while (audio_pkt_size > 0) do - begin -// writeln( 'got audio packet' ); - data_size := bufSize; - - if(pCodecCtx = nil) then begin - writeln('Das wars'); - exit; - end; - - // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. - len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), - data_size, audio_pkt_data, audio_pkt_size); - - //writeln('avcodec_decode_audio : ' + inttostr( len1 )); - - if(len1 < 0) then - begin - // if error, skip frame -// writeln( 'Skip audio frame' ); - audio_pkt_size := 0; - break; - end; - - audio_pkt_data := audio_pkt_data + len1; - audio_pkt_size := audio_pkt_size + len1; - - if (data_size <= 0) then - begin - // No data yet, get more frames - continue; - end; - - // We have data, return it and come back for more later - result := data_size; - exit; - end; - - inc(it); - if (pkt.data <> nil) then - begin - av_free_packet(pkt); - end; - - if (packetQueue.quit) then - begin - result := -1; - exit; - end; - writeln(it); - if (packetQueue.Get(pkt, true) < 0) then - begin - result := -1; - exit; - end; - - audio_pkt_data := PChar(pkt.data); - audio_pkt_size := pkt.size; -// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; -end; - -procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; -begin - outStream := TFFMpegOutputStream(userdata); - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; // Todo : jb - SegFault ? - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(stream, pSrc , len1); - {$else} - memcpy(stream, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(stream, len1); - Inc(audio_buf_index, len1); - end; -end; - -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; - len : integer; -begin - outStream := TFFMpegOutputStream(userData); - len := frameCount * 4; // use *2 for mono-files - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; // Todo : jb - SegFault ? - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(output, pSrc , len1); - {$else} - memcpy(output, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(PChar(output), len1); - Inc(audio_buf_index, len1); - end; - - result := paContinue; -end; - -function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; -var - i : integer; - streamID: integer; - stream : PAVStream; -begin - // Find the first audio stream - streamID := -1; - - for i := 0 to pFormatCtx^.nb_streams-1 do - begin - //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); - stream := pFormatCtx^.streams[i]; - - if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then - begin - Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); - streamID := i; - break; - end; - end; - - result := streamID; -end; - -function ParseAudio(data: Pointer): integer; cdecl; -var - packet: TAVPacket; - stream: TFFMpegOutputStream; -begin - stream := TFFMpegOutputStream(data); - - while (av_read_frame(stream.pFormatCtx, packet) >= 0) do - begin - //writeln( 'ffmpeg - av_read_frame' ); - - if (packet.stream_index = stream.ffmpegStreamID) then - begin - //writeln( 'packet_queue_put' ); - stream.packetQueue.put(@packet); - end - else - begin - av_free_packet(packet); - end; - end; - - //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); - - result := 0; -end; - - -function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; -var - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - wanted_spec, - spec : TSDL_AudioSpec; - csIndex : integer; - stream : TFFMpegOutputStream; - err : TPaError; -begin - result := nil; - - if (not FileExists(Name)) then - begin - Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); - exit; - end; - - // Open audio file - if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then - exit; - - // Retrieve stream information - if (av_find_stream_info(pFormatCtx) < 0) then - exit; - - dump_format(pFormatCtx, 0, pchar(Name), 0); - - ffmpegStreamID := FindAudioStreamID(pFormatCtx); - if (ffmpegStreamID < 0) then - exit; - - //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); - - ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; - pCodecCtx := ffmpegStream^.codec; - - pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); - if (pCodec = nil) then - begin - Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); - exit; - end; - - avcodec_open(pCodecCtx, pCodec); - //writeln( 'Opened the codec' ); - - stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, - ffmpegStreamID, ffmpegStream); - - { - // Set SDL audio settings from codec info - wanted_spec.freq := pCodecCtx^.sample_rate; - wanted_spec.format := AUDIO_S16SYS; - wanted_spec.channels := pCodecCtx^.channels; - wanted_spec.silence := 0; - wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; - wanted_spec.callback := AudioCallback; - wanted_spec.userdata := stream; - - // TODO: this works only one time (?) - if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then - begin - Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - } - - err := Pa_OpenDefaultStream(stream.channel, 0, pCodecCtx^.channels, paInt16, - pCodecCtx^.sample_rate, SDL_AUDIO_BUFFER_SIZE div 4, //paFramesPerBufferUnspecified, - @PA_AudioCallback, stream); - if(err <> paNoError) then begin - Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - - Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); - - //Add CustomSound - csIndex := High(CustomSounds) + 1; - SetLength (CustomSounds, csIndex + 1); - CustomSounds[csIndex].Filename := Name; - CustomSounds[csIndex].Stream := stream; - - result := stream; -end; - -//Equalizer -function TAudio_FFMpeg.GetFFTData: TFFTData; -var - data: TFFTData; -begin - //Get Channel Data Mono and 256 Values -// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - result := data; -end; - -// Interface for Visualizer -function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; -begin - result := 0; -end; - -function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; -var - S: TFFMpegOutputStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - S := LoadSoundFromFile(SoundPath + Filename); - if (S <> nil) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); -end; - - -constructor TPacketQueue.Create(); -begin - inherited; - - firstPkt := nil; - lastPkt := nil; - nbPackets := 0; - size := 0; - - mutex := SDL_CreateMutex(); - cond := SDL_CreateCond(); -end; - -function TPacketQueue.Put(pkt : PAVPacket): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - if (av_dup_packet(pkt) < 0) then - exit; - - pkt1 := av_malloc(sizeof(TAVPacketList)); - if (pkt1 = nil) then - exit; - - pkt1^.pkt := pkt^; - pkt1^.next := nil; - - - SDL_LockMutex(Self.mutex); - try - - if (Self.lastPkt = nil) then - Self.firstPkt := pkt1 - else - Self.lastPkt^.next := pkt1; - - Self.lastPkt := pkt1; - inc(Self.nbPackets); - - Writeln('Put: ' + inttostr(nbPackets)); - - Self.size := Self.size + pkt1^.pkt.size; - SDL_CondSignal(Self.cond); - - finally - SDL_UnlockMutex(Self.mutex); - end; - - result := 0; -end; - -function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - SDL_LockMutex(Self.mutex); - try - while true do - begin - if (quit) then - exit; - - pkt1 := Self.firstPkt; - - if (pkt1 <> nil) then - begin - Self.firstPkt := pkt1.next; - if (Self.firstPkt = nil) then - Self.lastPkt := nil; - dec(Self.nbPackets); - - Writeln('Get: ' + inttostr(nbPackets)); - - Self.size := Self.size - pkt1^.pkt.size; - pkt := pkt1^.pkt; - av_free(pkt1); - - result := 1; - break; - end - else - if (not block) then - begin - result := 0; - break; - end - else - begin - SDL_CondWait(Self.cond, Self.mutex); - end; - end; - finally - SDL_UnlockMutex(Self.mutex); - end; -end; - - - -initialization - singleton_MusicFFMpeg := TAudio_FFMpeg.create(); - - writeln( 'UAudio_FFMpeg - Register Playback' ); - AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); - -finalization - AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); - - -end. +unit UAudio_FFMpeg_Pa; + +(******************************************************************************* + +This unit is primarily based upon - + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + + and tutorial03.c + + http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*******************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + Messages, + SysUtils, + {$IFNDEF FPC} + Forms, + {$ENDIF} + SDL, // Used for Audio output Interface + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ifndef win32} + libc, // not available in win32 + {$endif} + {$ENDIF} + portaudio, + UIni, + UMain, + UThemes; + + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + firstPkt, + lastPkt : PAVPacketList; + nbPackets : integer; + size : integer; + mutex : PSDL_Mutex; + cond : PSDL_Cond; + quit : boolean; + + public + constructor Create(); + + function Put(pkt : PAVPacket): integer; + function Get(var pkt: TAVPacket; block: boolean): integer; + end; + +type + TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); + +const + StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); + +type + PAudioBuffer = ^TAudioBuffer; + TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; + +const + SDL_AUDIO_BUFFER_SIZE = 1024; + +type + TFFMpegOutputStream = class(TAudioOutputStream) + private + parseThread: PSDL_Thread; + packetQueue: TPacketQueue; + + status: TStreamStatus; + + // FFMpeg internal data + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + + // static vars for AudioDecodeFrame + pkt : TAVPacket; + audio_pkt_data : PChar; + audio_pkt_size : integer; + + // static vars for AudioCallback + audio_buf_index : cardinal; + audio_buf_size : cardinal; + audio_buf : TAudioBuffer; + + channel: PPaStream; + public + constructor Create(); overload; + constructor Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; + + procedure Play(); + procedure Pause(); + procedure Stop(); + procedure Close(); + + function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; + end; + +type + TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) + private + MusicStream: TFFMpegOutputStream; + + StartSoundStream: TFFMpegOutputStream; + BackSoundStream: TFFMpegOutputStream; + SwooshSoundStream: TFFMpegOutputStream; + ChangeSoundStream: TFFMpegOutputStream; + OptionSoundStream: TFFMpegOutputStream; + ClickSoundStream: TFFMpegOutputStream; + DrumSoundStream: TFFMpegOutputStream; + HihatSoundStream: TFFMpegOutputStream; + ClapSoundStream: TFFMpegOutputStream; + ShuffleSoundStream: TFFMpegOutputStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + + function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; + public + function GetName: String; + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Name: string): boolean; // true if succeed + procedure Rewind; + procedure MoveTo(Time: real); + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function getPosition: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + function LoadSoundFromFile(Name: string): TFFMpegOutputStream; + + //Equalizer + function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + end; + +var + test: TFFMpegOutputStream; + it: integer; + +var + singleton_MusicFFMpeg : IAudioPlayback = nil; + + +function ParseAudio(data: Pointer): integer; cdecl; forward; +procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; forward; + +constructor TFFMpegOutputStream.Create(); +begin + inherited; + + packetQueue := TPacketQueue.Create(); + + FillChar(pkt, sizeof(TAVPacket), #0); + + status := sStopped; + + audio_pkt_data := nil; + audio_pkt_size := 0; + + audio_buf_index := 0; + audio_buf_size := 0; +end; + +constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); +begin + Create(); + + Self.pFormatCtx := pFormatCtx; + Self.pCodecCtx := pCodecCtx; + Self.pCodec := pCodec; + Self.ffmpegStreamID := ffmpegStreamID; + Self.ffmpegStream := ffmpegStream; + + test := Self; + it:=0; +end; + +procedure TFFMpegOutputStream.Play(); +var + err: TPaError; +begin + writeln('Play request'); + if(status = sStopped) then + begin + writeln('Play ok'); + status := sPlaying; + Self.parseThread := SDL_CreateThread(@ParseAudio, Self); + //SDL_PauseAudio(0); + + err := Pa_StartStream(Self.channel); + end; +end; + +procedure TFFMpegOutputStream.Pause(); +begin +end; + +procedure TFFMpegOutputStream.Stop(); +begin +end; + +procedure TFFMpegOutputStream.Close(); +begin + // Close the codec + avcodec_close(pCodecCtx); + + // Close the video file + av_close_input_file(pFormatCtx); +end; + + +function TAudio_FFMpeg.GetName: String; +begin + result := 'FFMpeg'; +end; + +procedure TAudio_FFMpeg.InitializePlayback; +begin + Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); + + Loaded := false; + Loop := false; + + av_register_all(); + //SDL_Init(SDL_INIT_AUDIO); + Pa_Initialize(); + + StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); + { + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); + SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); + ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); + OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); + ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); + } +// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); +// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); +// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); + +// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); +end; + + +procedure TAudio_FFMpeg.SetVolume(Volume: integer); +begin + //New: Sets Volume only for this Application +(* + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +*) +end; + +procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + + //Set Volume +// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudio_FFMpeg.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin +// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudio_FFMpeg.Rewind; +begin + if Loaded then + begin + end; +end; + +procedure TAudio_FFMpeg.MoveTo(Time: real); +var + bytes: integer; +begin +// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); +// BASS_ChannelSetPosition(Bass, bytes); +end; + +procedure TAudio_FFMpeg.Play; +begin + if MusicStream <> nil then + if Loaded then + begin + if Loop then + begin + end; + // start from beginning... + // actually bass itself does not loop, nor does this TAudio_FFMpeg Class + MusicStream.Play(); + end; +end; + +procedure TAudio_FFMpeg.Pause; //Pause Mod +begin + if MusicStream <> nil then + if Loaded then begin + MusicStream.Pause(); // Pauses Song + end; +end; + +procedure TAudio_FFMpeg.Stop; +begin + if MusicStream <> nil then + MusicStream.Stop(); +end; + +procedure TAudio_FFMpeg.Close; +begin + if MusicStream <> nil then + MusicStream.Close(); +end; + +function TAudio_FFMpeg.Length: real; +var + bytes: integer; +begin + Result := 0; + // Todo : why is Music stream always nil !? + + if assigned( MusicStream ) then + begin + Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; + end; +end; + +function TAudio_FFMpeg.getPosition: real; +var + bytes: integer; +begin + Result := 0; + +(* + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +*) +end; + +function TAudio_FFMpeg.Finished: boolean; +begin + Result := false; + +(* + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +*) +end; + +procedure TAudio_FFMpeg.PlayStart; +begin + if StartSoundStream <> nil then + StartSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayBack; +begin + if BackSoundStream <> nil then + BackSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlaySwoosh; +begin + if SwooshSoundStream <> nil then + SwooshSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayChange; +begin + if ChangeSoundStream <> nil then + ChangeSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayOption; +begin + if OptionSoundStream <> nil then + OptionSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayClick; +begin + if ClickSoundStream <> nil then + ClickSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayDrum; +begin + if DrumSoundStream <> nil then + DrumSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayHihat; +begin + if HihatSoundStream <> nil then + HihatSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayClap; +begin + if ClapSoundStream <> nil then + ClapSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.PlayShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Play(); +end; + +procedure TAudio_FFMpeg.StopShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Stop(); +end; + + +function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; +var + len1, + data_size: integer; +begin + result := -1; + + if (buffer = nil) then + exit; + + while true do + begin + while (audio_pkt_size > 0) do + begin +// writeln( 'got audio packet' ); + data_size := bufSize; + + if(pCodecCtx = nil) then begin +// writeln('Das wars'); + exit; + end; + + // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), + data_size, audio_pkt_data, audio_pkt_size); + + //writeln('avcodec_decode_audio : ' + inttostr( len1 )); + + if(len1 < 0) then + begin + // if error, skip frame +// writeln( 'Skip audio frame' ); + audio_pkt_size := 0; + break; + end; + + audio_pkt_data := audio_pkt_data + len1; + audio_pkt_size := audio_pkt_size + len1; + + if (data_size <= 0) then + begin + // No data yet, get more frames + continue; + end; + + // We have data, return it and come back for more later + result := data_size; + exit; + end; + + inc(it); + if (pkt.data <> nil) then + begin + av_free_packet(pkt); + end; + + if (packetQueue.quit) then + begin + result := -1; + exit; + end; +// writeln(it); + if (packetQueue.Get(pkt, true) < 0) then + begin + result := -1; + exit; + end; + + audio_pkt_data := PChar(pkt.data); + audio_pkt_size := pkt.size; +// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + end; +end; + +procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; +var + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; +begin + outStream := TFFMpegOutputStream(userdata); + + while (len > 0) do + with outStream do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(stream, pSrc , len1); + {$else} + memcpy(stream, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(stream, len1); + Inc(audio_buf_index, len1); + end; +end; + +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; + len : integer; +begin + outStream := TFFMpegOutputStream(userData); + len := frameCount * 2; // use *2 for mono-files + + while (len > 0) do + with outStream do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(output, pSrc , len1); + {$else} + memcpy(output, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(PChar(output), len1); + Inc(audio_buf_index, len1); + end; + + result := paContinue; +end; + +function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; +var + i : integer; + streamID: integer; + stream : PAVStream; +begin + // Find the first audio stream + streamID := -1; + + for i := 0 to pFormatCtx^.nb_streams-1 do + begin + //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); + stream := pFormatCtx^.streams[i]; + + if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then + begin + Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); + streamID := i; + break; + end; + end; + + result := streamID; +end; + +function ParseAudio(data: Pointer): integer; cdecl; +var + packet: TAVPacket; + stream: TFFMpegOutputStream; +begin + stream := TFFMpegOutputStream(data); + + while (av_read_frame(stream.pFormatCtx, packet) >= 0) do + begin + //writeln( 'ffmpeg - av_read_frame' ); + + if (packet.stream_index = stream.ffmpegStreamID) then + begin + //writeln( 'packet_queue_put' ); + stream.packetQueue.put(@packet); + end + else + begin + av_free_packet(packet); + end; + end; + + //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); + + result := 0; +end; + + +function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; +var + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + wanted_spec, + spec : TSDL_AudioSpec; + csIndex : integer; + stream : TFFMpegOutputStream; + err : TPaError; +begin + result := nil; + + if (not FileExists(Name)) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); + writeln('ERROR : LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); + exit; + end; + + // Open audio file + if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then + exit; + + // Retrieve stream information + if (av_find_stream_info(pFormatCtx) < 0) then + exit; + + dump_format(pFormatCtx, 0, pchar(Name), 0); + + ffmpegStreamID := FindAudioStreamID(pFormatCtx); + if (ffmpegStreamID < 0) then + exit; + + //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + + ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; + pCodecCtx := ffmpegStream^.codec; + + pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); + if (pCodec = nil) then + begin + Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); + exit; + end; + + avcodec_open(pCodecCtx, pCodec); + //writeln( 'Opened the codec' ); + + stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, + ffmpegStreamID, ffmpegStream); + + { + // Set SDL audio settings from codec info + wanted_spec.freq := pCodecCtx^.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := pCodecCtx^.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := AudioCallback; + wanted_spec.userdata := stream; + + // TODO: this works only one time (?) + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); + stream.Free(); + exit; + end; + } + + err := Pa_OpenDefaultStream(stream.channel, 0, pCodecCtx^.channels, paInt16, + pCodecCtx^.sample_rate, SDL_AUDIO_BUFFER_SIZE div 2, //paFramesPerBufferUnspecified, + @PA_AudioCallback, stream); + if(err <> paNoError) then begin + Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); + stream.Free(); + exit; + end; + + Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); + + //Add CustomSound + csIndex := High(CustomSounds) + 1; + SetLength (CustomSounds, csIndex + 1); + CustomSounds[csIndex].Filename := Name; + CustomSounds[csIndex].Stream := stream; + + result := stream; +end; + +//Equalizer +function TAudio_FFMpeg.GetFFTData: TFFTData; +var + data: TFFTData; +begin + //Get Channel Data Mono and 256 Values +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + result := data; +end; + +// Interface for Visualizer +function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + +function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; +var + S: TFFMpegOutputStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + S := LoadSoundFromFile(SoundPath + Filename); + if (S <> nil) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); +end; + + +constructor TPacketQueue.Create(); +begin + inherited; + + firstPkt := nil; + lastPkt := nil; + nbPackets := 0; + size := 0; + + mutex := SDL_CreateMutex(); + cond := SDL_CreateCond(); +end; + +function TPacketQueue.Put(pkt : PAVPacket): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + if (av_dup_packet(pkt) < 0) then + exit; + + pkt1 := av_malloc(sizeof(TAVPacketList)); + if (pkt1 = nil) then + exit; + + pkt1^.pkt := pkt^; + pkt1^.next := nil; + + + SDL_LockMutex(Self.mutex); + try + + if (Self.lastPkt = nil) then + Self.firstPkt := pkt1 + else + Self.lastPkt^.next := pkt1; + + Self.lastPkt := pkt1; + inc(Self.nbPackets); + +// Writeln('Put: ' + inttostr(nbPackets)); + + Self.size := Self.size + pkt1^.pkt.size; + SDL_CondSignal(Self.cond); + + finally + SDL_UnlockMutex(Self.mutex); + end; + + result := 0; +end; + +function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + SDL_LockMutex(Self.mutex); + try + while true do + begin + if (quit) then + exit; + + pkt1 := Self.firstPkt; + + if (pkt1 <> nil) then + begin + Self.firstPkt := pkt1.next; + if (Self.firstPkt = nil) then + Self.lastPkt := nil; + dec(Self.nbPackets); + +// Writeln('Get: ' + inttostr(nbPackets)); + + Self.size := Self.size - pkt1^.pkt.size; + pkt := pkt1^.pkt; + av_free(pkt1); + + result := 1; + break; + end + else + if (not block) then + begin + result := 0; + break; + end + else + begin + SDL_CondWait(Self.cond, Self.mutex); + end; + end; + finally + SDL_UnlockMutex(Self.mutex); + end; +end; + + + +initialization + singleton_MusicFFMpeg := TAudio_FFMpeg.create(); + + writeln( 'UAudio_FFMpeg - Register Playback' ); + AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); + +finalization + AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); + + +end. -- cgit v1.2.3 From 252ffd6dadbce63252e5b6632ffc9daeb9484365 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 09:42:53 +0000 Subject: Scattered sound with portaudio works now (in linux) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@726 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 199 ++++++++++++++++++++++++++++-------- 1 file changed, 159 insertions(+), 40 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 9a242cd9..ca91f095 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -41,8 +41,11 @@ implementation uses {$IFDEF LAZARUS} lclintf, - libc, + {$ifndef win32} + libc, // not available in win32 + {$endif} {$ENDIF} + portaudio, UIni, UMain, UThemes; @@ -104,6 +107,9 @@ type audio_buf_index : cardinal; audio_buf_size : cardinal; audio_buf : TAudioBuffer; + + paStream : PPaStream; + paFrameSize : integer; public constructor Create(); overload; constructor Create(pFormatCtx: PAVFormatContext; @@ -181,17 +187,24 @@ type procedure PlayCustomSound(const Index: Cardinal ); end; +var + test: TFFMpegOutputStream; + it: integer; + var singleton_MusicFFMpeg : IAudioPlayback = nil; function ParseAudio(data: Pointer): integer; cdecl; forward; -procedure AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; +procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; forward; constructor TFFMpegOutputStream.Create(); begin inherited; - + packetQueue := TPacketQueue.Create(); FillChar(pkt, sizeof(TAVPacket), #0); @@ -210,14 +223,20 @@ constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; ffmpegStreamID : Integer; ffmpegStream: PAVStream); begin Create(); + Self.pFormatCtx := pFormatCtx; Self.pCodecCtx := pCodecCtx; Self.pCodec := pCodec; Self.ffmpegStreamID := ffmpegStreamID; Self.ffmpegStream := ffmpegStream; + + test := Self; + it:=0; end; procedure TFFMpegOutputStream.Play(); +var + err: TPaError; begin writeln('Play request'); if(status = sStopped) then @@ -225,7 +244,13 @@ begin writeln('Play ok'); status := sPlaying; Self.parseThread := SDL_CreateThread(@ParseAudio, Self); - SDL_PauseAudio(0); + //SDL_PauseAudio(0); + + err := Pa_StartStream(Self.paStream); + if(err <> paNoError) then + begin + Writeln('Play: '+ Pa_GetErrorText(err)); + end; end; end; @@ -260,11 +285,12 @@ begin Loop := false; av_register_all(); - SDL_Init(SDL_INIT_AUDIO); + //SDL_Init(SDL_INIT_AUDIO); + Pa_Initialize(); StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); { - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common back.mp3'); + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); @@ -380,28 +406,38 @@ begin if assigned( MusicStream ) then begin - //writeln( 'MusicStream : ' + inttostr( integer( assigned( MusicStream ))) ); - //writeln( 'MusicStream.pFormatCtx : ' + inttostr( integer( assigned( MusicStream.pFormatCtx ))) ); - //writeln( 'MusicStream.pFormatCtx^.duration : ' + inttostr( integer( MusicStream.pFormatCtx^.duration )) ); - Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; end; end; function TAudio_FFMpeg.getPosition: real; +var + bytes: integer; begin Result := 0; + +(* + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +*) end; function TAudio_FFMpeg.Finished: boolean; begin Result := false; + +(* + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +*) end; procedure TAudio_FFMpeg.PlayStart; begin if StartSoundStream <> nil then - StartSoundStream.Play(); + StartSoundStream.Play(); end; procedure TAudio_FFMpeg.PlayBack; @@ -464,6 +500,7 @@ begin ShuffleSoundStream.Stop(); end; + function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; var len1, @@ -474,20 +511,23 @@ begin if (buffer = nil) then exit; - while true do - begin - + begin while (audio_pkt_size > 0) do begin // writeln( 'got audio packet' ); data_size := bufSize; + if(pCodecCtx = nil) then begin +// writeln('Das wars'); + exit; + end; + // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), data_size, audio_pkt_data, audio_pkt_size); -// writeln('avcodec_decode_audio : ' + inttostr( len1 )); + //writeln('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin @@ -506,37 +546,36 @@ begin continue; end; - // We have data, return it and come back for more later + // We have data, return it and come back for more later result := data_size; exit; end; + inc(it); if (pkt.data <> nil) then + begin av_free_packet(pkt); - - + end; if (packetQueue.quit) then begin result := -1; exit; end; - +// writeln(it); if (packetQueue.Get(pkt, true) < 0) then begin result := -1; exit; end; - audio_pkt_data := PChar(pkt.data); audio_pkt_size := pkt.size; // writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); end; - end; -procedure AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; +procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; var outStream : TFFMpegOutputStream; len1, @@ -546,21 +585,19 @@ begin outStream := TFFMpegOutputStream(userdata); while (len > 0) do - with outStream do - begin - + with outStream do begin if (audio_buf_index >= audio_buf_size) then begin // We have already sent all our data; get more audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); -// writeln('audio_decode_frame : '+ inttostr(audio_size)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); if(audio_size < 0) then begin // If error, output silence audio_buf_size := 1024; FillChar(audio_buf, audio_buf_size, #0); -// writeln( 'Silence' ); + //writeln( 'Silence' ); end else begin @@ -583,9 +620,61 @@ begin Dec(len, len1); Inc(stream, len1); Inc(audio_buf_index, len1); + end; +end; + +function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + outStream : TFFMpegOutputStream; + len1, + audio_size : integer; + pSrc : Pointer; + len : integer; +begin + outStream := TFFMpegOutputStream(userData); + len := frameCount * outStream.paFrameSize; + while (len > 0) do + with outStream do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; // Todo : jb - SegFault ? + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(output, pSrc , len1); + {$else} + memcpy(output, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(PChar(output), len1); + Inc(audio_buf_index, len1); end; + result := paContinue; end; function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; @@ -622,7 +711,7 @@ begin while (av_read_frame(stream.pFormatCtx, packet) >= 0) do begin -// writeln( 'ffmpeg - av_read_frame' ); + //writeln( 'ffmpeg - av_read_frame' ); if (packet.stream_index = stream.ffmpegStreamID) then begin @@ -633,10 +722,9 @@ begin begin av_free_packet(packet); end; - end; -// Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); + //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); result := 0; end; @@ -653,12 +741,20 @@ var spec : TSDL_AudioSpec; csIndex : integer; stream : TFFMpegOutputStream; + err : TPaError; + // move this to a portaudio specific section + paOutParams : TPaStreamParameters; + paApiInfo : PPaHostApiInfo; + paApi : TPaHostApiIndex; + paOutDevice : TPaDeviceIndex; + paOutDeviceInfo : PPaDeviceInfo; begin result := nil; if (not FileExists(Name)) then begin Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); + writeln('ERROR : LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); exit; end; @@ -694,6 +790,7 @@ begin stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, ffmpegStreamID, ffmpegStream); + { // Set SDL audio settings from codec info wanted_spec.freq := pCodecCtx^.sample_rate; wanted_spec.format := AUDIO_S16SYS; @@ -708,7 +805,32 @@ begin begin Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); stream.Free(); - exit + exit; + end; + } + + paApi := Pa_HostApiTypeIdToHostApiIndex(paALSA); + paApiInfo := Pa_GetHostApiInfo(paApi); + paOutDevice := paApiInfo^.defaultOutputDevice; + paOutDeviceInfo := Pa_GetDeviceInfo(paOutDevice); + + with paOutParams do begin + device := paOutDevice; + channelCount := pCodecCtx^.channels; + sampleFormat := paInt16; + suggestedLatency := paOutDeviceInfo^.defaultHighOutputLatency; + hostApiSpecificStreamInfo := nil; + end; + + stream.paFrameSize := sizeof(Smallint) * pCodecCtx^.channels; + + err := Pa_OpenStream(stream.paStream, nil, @paOutParams, pCodecCtx^.sample_rate, + paFramesPerBufferUnspecified, //SDL_AUDIO_BUFFER_SIZE div stream.paFrameSize + paNoFlag, @PA_AudioCallback, stream); + if(err <> paNoError) then begin + Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); + stream.Free(); + exit; end; Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); @@ -786,7 +908,6 @@ function TPacketQueue.Put(pkt : PAVPacket): integer; var pkt1 : PAVPacketList; begin - result := -1; if (av_dup_packet(pkt) < 0) then @@ -801,7 +922,7 @@ begin SDL_LockMutex(Self.mutex); -// try + try if (Self.lastPkt = nil) then Self.firstPkt := pkt1 @@ -816,9 +937,9 @@ begin Self.size := Self.size + pkt1^.pkt.size; SDL_CondSignal(Self.cond); -// finally + finally SDL_UnlockMutex(Self.mutex); -// end; + end; result := 0; end; @@ -827,11 +948,10 @@ function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; var pkt1 : PAVPacketList; begin - result := -1; SDL_LockMutex(Self.mutex); -// try + try while true do begin if (quit) then @@ -866,10 +986,9 @@ begin SDL_CondWait(Self.cond, Self.mutex); end; end; -// finally + finally SDL_UnlockMutex(Self.mutex); -// end; - + end; end; -- cgit v1.2.3 From f3ee66ae042f65832d9230dbdaec352b17420bfd Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 12:12:15 +0000 Subject: start-sound works now. JAY: it's a '-' not a '+' git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@727 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index ca91f095..fb25b0f9 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -289,13 +289,12 @@ begin Pa_Initialize(); StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); - { - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); + BackSoundStream := LoadSoundFromFile(SoundPath + 'Common back.mp3'); SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); - } + // DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); // HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); // ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); @@ -537,8 +536,8 @@ begin break; end; - audio_pkt_data := audio_pkt_data + len1; - audio_pkt_size := audio_pkt_size + len1; + Inc(audio_pkt_data, len1); + Dec(audio_pkt_size, len1); if (data_size <= 0) then begin @@ -603,7 +602,7 @@ begin begin audio_buf_size := audio_size; end; - audio_buf_index := 0; // Todo : jb - SegFault ? + audio_buf_index := 0; end; len1 := audio_buf_size - audio_buf_index; @@ -833,7 +832,7 @@ begin exit; end; - Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); + Log.LogStatus('Opened audio device', 'UAudio_FFMpeg'); //Add CustomSound csIndex := High(CustomSounds) + 1; -- cgit v1.2.3 From ff85cdbd66a19dd80ed4d09b8cca7b0bf3ebf77b Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 18 Dec 2007 15:49:16 +0000 Subject: incorporated some improvements (video scaling to full width, seeking for videogap) from 1.0.1 cleanup in UVideo.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@728 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 148 ++++++++++--------------------------------- 1 file changed, 33 insertions(+), 115 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 42971daf..4f6b566a 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -37,7 +37,6 @@ uses SDL, avcodec, avformat, avutil, -// swscale, math, OpenGL12, SysUtils, @@ -66,9 +65,6 @@ type fVideoTex : glUint; fVideoSkipTime : Single; - //remove - fTexData : array of Byte; - VideoFormatContext: PAVFormatContext; VideoStreamIndex , @@ -79,8 +75,6 @@ type AVFrameRGB: PAVFrame; myBuffer: pByte; -// SoftwareScaleContext: PSwsContext; - TexX, TexY, dataX, dataY: Cardinal; ScaledVideoWidth, ScaledVideoHeight: Real; @@ -93,8 +87,8 @@ type AudioCodecContext : PSDL_AudioSpec; aCodecCtx : PAVCodecContext; - function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + public constructor create(); function GetName: String; @@ -215,9 +209,9 @@ begin {$IFDEF DebugDisplay} showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ - 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); {$endif} if (VideoTime <> 0) and (TimeDifference <= VideoTimeBase) then @@ -238,7 +232,6 @@ begin Exit;// we don't need a new frame now end; - VideoTime:=VideoTime+VideoTimeBase; TimeDifference:=myTime-VideoTime; if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames @@ -247,35 +240,25 @@ begin //frame drop debug display GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); {$endif} - {$IFDEF DebugDisplay} - showmessage('skipping frames'+#13#10+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); - {$endif} -// av_seek_frame(VideoFormatContext.,VideoStreamIndex,Floor(Time*VideoTimeBase),0); -{ av_seek_frame(VideoFormatContext,-1,Floor((myTime+VideoTimeBase)*1500000),0); - VideoTime:=floor(myTime/VideoTimeBase)*VideoTimeBase;} VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; DropFrame:=True; end; - -// av_init_packet(@AVPacket); AVPacket.data := nil; av_init_packet( AVPacket ); // JB-ffmpeg - FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) - while ( FrameFinished = 0 ) and - ( av_read_frame(VideoFormatContext, AVPacket) >= 0 ) do // JB-ffmpeg + while ( FrameFinished = 0 ) do begin - - + if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then + break; // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then begin @@ -293,7 +276,7 @@ begin end; try - if AVPacket.data <> nil then +// if AVPacket.data <> nil then av_free_packet( AVPacket ); // JB-ffmpeg except // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) @@ -301,72 +284,46 @@ begin end; - if DropFrame then for droppedFrames:=1 to FRAMEDROPCOUNT do begin FrameFinished:=0; // read packets until we have a finished frame (or there are no more packets) -// while (FrameFinished=0) and (av_read_frame(VideoFormatContext, @AVPacket)>=0) do - while (FrameFinished=0) and (av_read_frame(VideoFormatContext, AVPacket)>=0) do // JB-ffmpeg + while (FrameFinished=0) do begin + if (av_read_frame(VideoFormatContext, AVPacket)<0) then + Break; // if we got a packet from the video stream, then decode it if (AVPacket.stream_index=VideoStreamIndex) then -// errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, @frameFinished, AVPacket.data, AVPacket.size); errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg - // release internal packet structure created by av_read_frame -// av_free_packet(PAVPacket(@AVPacket)); // JB-ffmpeg - av_free_packet( AVPacket ); + try +// if AVPacket.data <> nil then + av_free_packet( AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; end; end; // if we did not get an new frame, there's nothing more to do if Framefinished=0 then begin - GoldenRec.Spawn(220,15,1,16,0,-1,ColoredStar,$0000ff); Exit; end; // otherwise we convert the pixeldata from YUV to RGB errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, VideoCodecContext^.width, VideoCodecContext^.height); -//errnum:=1; -{ - writeln('swscontext->srcH='+inttostr(SoftwareScaleContext^.srcH)); - writeln('swscontext->dstH='+inttostr(SoftwareScaleContext^.dstH)); - writeln('swscontext->slicedir='+inttostr(SoftwareScaleContext^.slicedir)); - errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize), - 0,VideoCodecContext^.Height, - @(AVFrameRGB.data),@(AVFrameRGB.linesize)); - writeln('errnum='+inttostr(errnum)); -} if errnum >=0 then begin glBindTexture(GL_TEXTURE_2D, fVideoTex); glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); -(* // copy RGB pixeldata to our TextureBuffer - // (line by line) - - FrameDataPtr := pointer( AVFrameRGB^.data[0] ); - linesize := AVFrameRGB^.linesize[0]; - for y:=0 to TexY-1 do - begin - System.Move(FrameDataPtr[y*linesize],fTexData[3*y*dataX],linesize); - end; - - // generate opengl texture out of whatever we got - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, fTexData); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); -*) {$ifdef DebugFrames} //frame decode debug display GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); {$endif} - end; end; @@ -440,7 +397,6 @@ end; procedure TVideoPlayback_ffmpeg.init(); begin glGenTextures(1, PglUint(@fVideoTex)); - SetLength(fTexData,0); end; @@ -560,7 +516,6 @@ begin Exit; end; - if(VideoCodec<>Nil) then begin errnum:=avcodec_open(VideoCodecContext, VideoCodec); @@ -598,10 +553,8 @@ begin if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then begin myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY)); -// myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, VideoCodecContext^.width, VideoCodecContext^.height)); end; if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, -// VideoCodecContext^.width, VideoCodecContext^.height) dataX, dataY) else begin {$ifdef DebugDisplay} @@ -613,24 +566,6 @@ begin av_close_input_file(VideoFormatContext); Exit; end; -{ - writeln('trying to get sws context: '+inttostr(VideoCodecContext^.width)+'x'+ - inttostr(VideoCodecContext^.height)+' -> '+inttostr(dataX)+'x'+inttostr(dataY)); - SoftwareScaleContext:=Nil; - SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), - dataX, dataY, integer(PIX_FMT_RGB24), - SWS_FAST_BILINEAR, 0, 0, 0); - if SoftwareScaleContext <> Nil then - writeln('got swscale context') - else begin - writeln('ERROR: didn´t get swscale context'); - av_free(AVFrameRGB); - av_free(AVFrame); - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - Exit; - end; -} // this is the errnum from avpicture_fill if errnum >=0 then begin @@ -640,41 +575,26 @@ begin TexY := VideoCodecContext^.height; dataX := Round(Power(2, Ceil(Log2(TexX)))); dataY := Round(Power(2, Ceil(Log2(TexY)))); - SetLength(fTexData,dataX*dataY*3); // calculate some information for video display VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; if (VideoAspect = 0) then VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height else VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; - if VideoAspect >= 4/3 then - begin ScaledVideoWidth:=800.0; ScaledVideoHeight:=800.0/VideoAspect; - end else - begin - ScaledVideoHeight:=600.0; - ScaledVideoWidth:=600.0*VideoAspect; - end; - VideoTimeBase:=VideoCodecContext^.time_base.num/VideoCodecContext^.time_base.den; - // hack to get reasonable timebase for divx -{$ifdef DebugDisplay} - showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); -{$endif} - if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps - begin - VideoTimeBase:=VideoCodecContext^.time_base.den/VideoCodecContext^.time_base.num; - while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; - VideoTimeBase:=1/VideoTimeBase; - end; -{$ifdef DebugDisplay} - showmessage('corrected framerate: '+inttostr(floor(1/videotimebase))+'fps'); - - if ((VideoAspect*VideoCodecContext^.width*VideoCodecContext^.height)>200000) then - showmessage('you are trying to play a rather large video'+#13#10+ - 'be prepared to experience some timing problems'); -{$endif} - end; + VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num; +{$ifdef DebugDisplay} + showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); +{$endif} + // hack to get reasonable timebase (for divx and others) + if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps + begin + VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den; + while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; + VideoTimeBase:=1/VideoTimeBase; + end; + end; end; end; @@ -689,8 +609,6 @@ begin avcodec_close(VideoCodecContext); av_close_input_file(VideoFormatContext); - SetLength(fTexData,0); - fVideoOpened:=False; end; end; @@ -711,18 +629,19 @@ end; procedure TVideoPlayback_ffmpeg.MoveTo(Time: real); begin fVideoSkipTime := Time; - + if fVideoSkipTime > 0 then begin - av_seek_frame(VideoFormatContext,-1,Floor((fVideoSkipTime)*1500000),0); + av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY); VideoTime := fVideoSkipTime; end; end; +// what is this supposed to do? return VideoTime? function TVideoPlayback_ffmpeg.getPosition: real; begin - result := 0; + result := 0; end; initialization @@ -732,5 +651,4 @@ initialization finalization AudioManager.Remove( singleton_VideoFFMpeg ); - end. -- cgit v1.2.3 From 0f482be3ee9588081363963b382faabcef07c295 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 23:47:42 +0000 Subject: Added a missing override for the destroy-destructor git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@730 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 445c7d4f..8701673e 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -100,7 +100,7 @@ type function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); Constructor Create; - Destructor Destroy; + Destructor Destroy; override; end; var -- cgit v1.2.3 From 0d5fbd096cddf37bfc3a5f642644179c81bde582 Mon Sep 17 00:00:00 2001 From: mogguh Date: Thu, 20 Dec 2007 00:21:32 +0000 Subject: Minor refinings in score screen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@732 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 47 ++++++++++++++++++++++++++++++++++++++++-- Game/Code/Classes/UThemes.pas | 4 ++++ 2 files changed, 49 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index f774a899..32d7d304 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -157,8 +157,20 @@ var //End PhrasenBonus - Line Bonus Mod //ScoreBG Texs - Tex_ScoreBG: array [0..5] of TTexture; + Tex_ScoreBG: array [1..6] of TTexture; + //Score Screen Textures + Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; + + Tex_Score_Ratings : array [0..6] of TTexture; + const Skin_BGColorR = 1; Skin_BGColorG = 1; @@ -348,14 +360,45 @@ begin Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); end; - //Score BG Textures +//## backgrounds for the scores ## for P := 0 to 5 do begin LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); end; + Log.LogStatus('Loading Textures - D', 'LoadTextures'); + +// ###################### +// Score screen textures +// ###################### + +//## the bars that visualize the score ## + for P := 1 to 6 do begin +//NoteBar ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col); +//LineBonus ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col); +//GoldenNotes ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col); + end; + +//## rating pictures that show a picture according to your rate ## + for P := 0 to 6 do begin + Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0); + end; + + Log.LogStatus('Loading Textures - Done', 'LoadTextures'); end; procedure Initialize3D (Title: string); diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index f7b08479..1c731ce0 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -343,6 +343,8 @@ type 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; @@ -1082,6 +1084,8 @@ begin 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 -- cgit v1.2.3 From 7d61a98f807803a337fd12342c29eb0f5f69fc76 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Dec 2007 03:33:14 +0000 Subject: made USDX function when file paths differ from previous expectations.. ( most of the software was still using hard coded paths ) also added ability to have multiple song directories. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@735 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 1593 +++++++++++++++++----------------- Game/Code/Classes/UMain.pas | 36 +- Game/Code/Classes/UPlatform.pas | 63 +- Game/Code/Classes/UPlatformLinux.pas | 38 + Game/Code/Classes/USkins.pas | 35 +- Game/Code/Classes/USongs.pas | 9 +- Game/Code/Classes/UThemes.pas | 179 ++-- Game/Code/Classes/Ulazjpeg.pas | 300 +++---- 8 files changed, 1178 insertions(+), 1075 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index f1b73d38..0e84c506 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -1,794 +1,799 @@ -unit UIni; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses IniFiles, ULog, SysUtils; - -type - TIni = class - Name: array[0..11] of string; - - // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; - - //Filename of the opened iniFile - Filename: string; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - Threshold: integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - - // Record - Card: integer; // not saved in config.ini - - CardList: array of record - Name: string; - Input: integer; - ChannelL: integer; - ChannelR: integer; - end; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskbeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - - // Soundcards - SoundCard: array[0..7, 1..2] of integer; - - // Devices - LPT: integer; - - procedure Load; - procedure Save; - procedure SaveNames; - procedure SaveLevel; - end; - - -var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - ICard: array of string; - IInput: array of string; - -const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); - - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; - - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ISingWindow: array[0..1] of string = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); - //IOscilloscope: array[0..1] of string = ('Off', 'On'); - - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - - - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array [0..1] of String =('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); - - IJoypad: array[0..1] of string = ('Off', 'On'); - ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); - - IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); - -implementation - -uses //UFiles, - UMain, - SDL, - ULanguage, - USkins, - URecord, - UCommandLine; - -procedure TIni.Load; -var - IniFile: TMemIniFile; - ThemeIni: TMemIniFile; - Tekst: string; - Pet: integer; - B: boolean; - I, I2, I3: integer; - S: string; - Modes: PPSDL_Rect; - SR: TSearchRec; //Skin List Patch - - function GetFileName (S: String):String; - begin - //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); - Result := copy (S,0,Pos ('.ini',S)-1); - end; - -begin - GamePath := ExtractFilePath(ParamStr(0)); - - if (Params.ConfigFile <> '') then - try - IniFile := TMemIniFile.Create(Params.ConfigFile); - except - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - end - else - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - - - // Name - for I := 0 to 11 do - Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - - // Templates for Names Mod - for I := 0 to 2 do - Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); - for Pet := 0 to High(IPlayers) do - if Tekst = IPlayers[Pet] then Ini.Players := Pet; - - // Difficulty - Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); - for Pet := 0 to High(IDifficulty) do - if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; - - // Language - Tekst := IniFile.ReadString('Game', 'Language', 'English'); - for Pet := 0 to High(ILanguage) do - if Tekst = ILanguage[Pet] then Ini.Language := Pet; - -// Language.ChangeLanguage(ILanguage[Ini.Language]); - - // Tabs - Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); - for Pet := 0 to High(ITabs) do - if Tekst = ITabs[Pet] then Ini.Tabs := Pet; - - //Tabs at Startup fix - Ini.Tabs_at_startup := Ini.Tabs; - - // Sorting - Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); - for Pet := 0 to High(ISorting) do - if Tekst = ISorting[Pet] then Ini.Sorting := Pet; - - // Debug - Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); - for Pet := 0 to High(IDebug) do - if Tekst = IDebug[Pet] then Ini.Debug := Pet; - - //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; - - // Screens - Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); - for Pet := 0 to High(IScreens) do - if Tekst = IScreens[Pet] then Ini.Screens := Pet; - - // FullScreen - Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); - for Pet := 0 to High(IFullScreen) do - if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; - - - // Resolution - SetLength(IResolution, 0); - - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - end; - - // if no modes were set, then failback to 800x600 - // as per http://sourceforge.net/forum/message.php?msg_id=4544965 - // THANKS : linnex at users.sourceforge.net - if Length(IResolution) < 1 then - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); - Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); - - // Default to fullscreen OFF, in this case ! - Ini.FullScreen := 0; - end; - - // reverse order - for I := 0 to (Length(IResolution) div 2) - 1 do begin - S := IResolution[I]; - IResolution[I] := IResolution[High(IResolution)-I]; - IResolution[High(IResolution)-I] := S; - end; - - Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - for Pet := 0 to High(IResolution) do - if Tekst = IResolution[Pet] then Ini.Resolution := Pet; - - - // Resolution - Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); - for Pet := 0 to High(IDepth) do - if Tekst = IDepth[Pet] then Ini.Depth := Pet; - - // Texture Size - Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); - for Pet := 0 to High(ITextureSize) do - if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; - - // SingWindow - Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); - for Pet := 0 to High(ISingWindow) do - if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; - - // Oscilloscope - Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); - for Pet := 0 to High(IOscilloscope) do - if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; - - // Spectrum - Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); - for Pet := 0 to High(ISpectrum) do - if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; - - // Spectrograph - Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); - for Pet := 0 to High(ISpectrograph) do - if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; - - // MovieSize - Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); - for Pet := 0 to High(IMovieSize) do - if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; - - // MicBoost - Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); - for Pet := 0 to High(IMicBoost) do - if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; - - // ClickAssist - Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); - for Pet := 0 to High(IClickAssist) do - if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; - - // BeatClick - Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); - for Pet := 0 to High(IBeatClick) do - if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; - - // SavePlayback - Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); - for Pet := 0 to High(ISavePlayback) do - if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; - - // Threshold - Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); - for Pet := 0 to High(IThreshold) do - if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; - - //Song Preview - Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); - for Pet := 0 to High(IPreviewVolume) do - if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; - - Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); - for Pet := 0 to High(IPreviewFading) do - if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; - - // Lyrics Font - Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); - for Pet := 0 to High(ILyricsFont) do - if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; - - // Lyrics Effect - Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); - for Pet := 0 to High(ILyricsEffect) do - if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; - - // Solmization - Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); - for Pet := 0 to High(ISolmization) do - if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; - - // Theme - - //Theme List Patch - - //I2 Saves the no of the Deluxe (Standard-) Theme - I2 := 0; - //I counts is the cur. Theme no - I := 0; - - SetLength(ITheme, 0); - FindFirst('Themes' + PathDelim + '*.ini',faAnyFile,SR); - Repeat - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SR.Name); - Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); - ThemeIni.Free; - - //if Deluxe Theme then save Themeno to I2 - if (Tekst = 'DELUXE') then - I2 := I; - - //Search for Skins for this Theme - for Pet := low(Skin.Skin) to high(Skin.Skin) do - begin - if UpperCase(Skin.Skin[Pet].Theme) = Tekst then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := GetFileName(SR.Name); - break; - end; - end; - - Inc(I); - Until FindNext(SR) <> 0; - FindClose(SR); - //Theme List Patch End } - - //No Theme Found - if (Length(ITheme)=0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - - Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); - Ini.Theme := 0; - for Pet := 0 to High(ITheme) do - if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; - - // Skin - Skin.onThemeChange; - Ini.SkinNo := 0; - - Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); - for Pet := 0 to High(ISkin) do - if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; - - // Color - Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); - for Pet := 0 to High(IColor) do - if Tekst = IColor[Pet] then Ini.Color := Pet; - - // Record - load ini list - SetLength(CardList, 0); - I := 1; - while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin - //Automatically Delete not Existing Sound Cards - S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); - //{ - B := False; - //Look for Soundcard - for I2 := 0 to High(Recording.SoundCard) do - begin - if (S = Trim(Recording.SoundCard[I2].Description)) then - begin - B := True; - Break; - end; - end; - - if B then - begin //} - I3 := Length(CardList); - SetLength(CardList, I3+1); - Ini.CardList[I3].Name := S; - Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); - Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); - Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); - end; - Inc(I); - end; - - // Record - append detected soundcards - for I := 0 to High(Recording.SoundCard) do - begin - B := False; - For I2 := 0 to High(CardList) do - begin //Search for Card in List - if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then - begin - B := True; - Break; - end; - end; - - //If not in List -> Add - If not B then - begin - I3 := Length(CardList); - SetLength(CardList, I3+1); - CardList[I3].Name := Trim(Recording.SoundCard[I].Description); - CardList[I3].Input := 0; - CardList[I3].ChannelL := 0; - CardList[I3].ChannelR := 0; - // default for new users - if (Length(CardList) = 1) then - CardList[I].ChannelL := 1; - end; - end; - - //Advanced Settings - - // LoadAnimation - Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); - for Pet := 0 to High(ILoadAnimation) do - if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; - - // ScreenFade - Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); - for Pet := 0 to High(IScreenFade) do - if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; - - // EffectSing - Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); - for Pet := 0 to High(IEffectSing) do - if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; - - // AskbeforeDel - Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); - for Pet := 0 to High(IAskbeforeDel) do - if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; - - // OnSongClick - Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); - for Pet := 0 to High(IOnSongClick) do - if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; - - // Linebonus - Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); - for Pet := 0 to High(ILineBonus) do - if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - - // PartyPopup - Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); - for Pet := 0 to High(IPartyPopup) do - if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; - - - // Joypad - Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); - for Pet := 0 to High(IJoypad) do - if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - - // LCD - Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); - for Pet := 0 to High(ILPT) do - if Tekst = ILPT[Pet] then Ini.LPT := Pet; - - - // SongPath - if (Params.SongPath <> '') then - SongPath := IncludeTrailingPathDelimiter(Params.SongPath) - else - SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); - - Filename := IniFile.FileName; - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; - Tekst: string; - I: Integer; - S: String; -begin - //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin - if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin - - IniFile := TIniFile.Create(Filename); - - // Players - Tekst := IPlayers[Ini.Players]; - IniFile.WriteString('Game', 'Players', Tekst); - - // Difficulty - Tekst := IDifficulty[Ini.Difficulty]; - IniFile.WriteString('Game', 'Difficulty', Tekst); - - // Language - Tekst := ILanguage[Ini.Language]; - IniFile.WriteString('Game', 'Language', Tekst); - - // Tabs - Tekst := ITabs[Ini.Tabs]; - IniFile.WriteString('Game', 'Tabs', Tekst); - - // Sorting - Tekst := ISorting[Ini.Sorting]; - IniFile.WriteString('Game', 'Sorting', Tekst); - - // Debug - Tekst := IDebug[Ini.Debug]; - IniFile.WriteString('Game', 'Debug', Tekst); - - // Screens - Tekst := IScreens[Ini.Screens]; - IniFile.WriteString('Graphics', 'Screens', Tekst); - - // FullScreen - Tekst := IFullScreen[Ini.FullScreen]; - IniFile.WriteString('Graphics', 'FullScreen', Tekst); - - // Resolution - Tekst := IResolution[Ini.Resolution]; - IniFile.WriteString('Graphics', 'Resolution', Tekst); - - // Depth - Tekst := IDepth[Ini.Depth]; - IniFile.WriteString('Graphics', 'Depth', Tekst); - - // Resolution - Tekst := ITextureSize[Ini.TextureSize]; - IniFile.WriteString('Graphics', 'TextureSize', Tekst); - - // Sing Window - Tekst := ISingWindow[Ini.SingWindow]; - IniFile.WriteString('Graphics', 'SingWindow', Tekst); - - // Oscilloscope - Tekst := IOscilloscope[Ini.Oscilloscope]; - IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - - // Spectrum - Tekst := ISpectrum[Ini.Spectrum]; - IniFile.WriteString('Graphics', 'Spectrum', Tekst); - - // Spectrograph - Tekst := ISpectrograph[Ini.Spectrograph]; - IniFile.WriteString('Graphics', 'Spectrograph', Tekst); - - // Movie Size - Tekst := IMovieSize[Ini.MovieSize]; - IniFile.WriteString('Graphics', 'MovieSize', Tekst); - - // MicBoost - Tekst := IMicBoost[Ini.MicBoost]; - IniFile.WriteString('Sound', 'MicBoost', Tekst); - - // ClickAssist - Tekst := IClickAssist[Ini.ClickAssist]; - IniFile.WriteString('Sound', 'ClickAssist', Tekst); - - // BeatClick - Tekst := IBeatClick[Ini.BeatClick]; - IniFile.WriteString('Sound', 'BeatClick', Tekst); - - // Threshold - Tekst := IThreshold[Ini.Threshold]; - IniFile.WriteString('Sound', 'Threshold', Tekst); - - // Song Preview - Tekst := IPreviewVolume[Ini.PreviewVolume]; - IniFile.WriteString('Sound', 'PreviewVolume', Tekst); - - Tekst := IPreviewFading[Ini.PreviewFading]; - IniFile.WriteString('Sound', 'PreviewFading', Tekst); - - // SavePlayback - Tekst := ISavePlayback[Ini.SavePlayback]; - IniFile.WriteString('Sound', 'SavePlayback', Tekst); - - // Lyrics Font - Tekst := ILyricsFont[Ini.LyricsFont]; - IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); - - // Lyrics Effect - Tekst := ILyricsEffect[Ini.LyricsEffect]; - IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); - - // Solmization - Tekst := ISolmization[Ini.Solmization]; - IniFile.WriteString('Lyrics', 'Solmization', Tekst); - - // Theme - Tekst := ITheme[Ini.Theme]; - IniFile.WriteString('Themes', 'Theme', Tekst); - - // Skin - Tekst := ISkin[Ini.SkinNo]; - IniFile.WriteString('Themes', 'Skin', Tekst); - - // Color - Tekst := IColor[Ini.Color]; - IniFile.WriteString('Themes', 'Color', Tekst); - - // Record - for I := 0 to High(CardList) do begin - S := IntToStr(I+1); - - Tekst := CardList[I].Name; - IniFile.WriteString('Record', 'DeviceName' + S, Tekst); - - Tekst := IntToStr(CardList[I].Input); - IniFile.WriteString('Record', 'Input' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelL); - IniFile.WriteString('Record', 'ChannelL' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelR); - IniFile.WriteString('Record', 'ChannelR' + S, Tekst); - end; - - //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); - - //Advanced Settings - - //LoadAnimation - Tekst := ILoadAnimation[Ini.LoadAnimation]; - IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - - //EffectSing - Tekst := IEffectSing[Ini.EffectSing]; - IniFile.WriteString('Advanced', 'EffectSing', Tekst); - - //ScreenFade - Tekst := IScreenFade[Ini.ScreenFade]; - IniFile.WriteString('Advanced', 'ScreenFade', Tekst); - - //AskbeforeDel - Tekst := IAskbeforeDel[Ini.AskbeforeDel]; - IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); - - //OnSongClick - Tekst := IOnSongClick[Ini.OnSongClick]; - IniFile.WriteString('Advanced', 'OnSongClick', Tekst); - - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Advanced', 'LineBonus', Tekst); - - //Party Popup - Tekst := IPartyPopup[Ini.PartyPopup]; - IniFile.WriteString('Advanced', 'PartyPopup', Tekst); - - // Joypad - Tekst := IJoypad[Ini.Joypad]; - IniFile.WriteString('Controller', 'Joypad', Tekst); - - IniFile.Free; - end; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - //Name - // Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); - - IniFile.Free; - end; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); - - IniFile.Free; - end; -end; - -end. \ No newline at end of file +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses IniFiles, ULog, SysUtils; + +type + TIni = class + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + Threshold: integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + + // Record + Card: integer; // not saved in config.ini + + CardList: array of record + Name: string; + Input: integer; + ChannelL: integer; + ChannelR: integer; + end; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskbeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + // Soundcards + SoundCard: array[0..7, 1..2] of integer; + + // Devices + LPT: integer; + + procedure Load; + procedure Save; + procedure SaveNames; + procedure SaveLevel; + end; + + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + ICard: array of string; + IInput: array of string; + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); + //IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array [0..1] of String =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); + + IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + +implementation + +uses //UFiles, + UMain, + SDL, + ULanguage, + USkins, + URecord, + UCommandLine; + +procedure TIni.Load; +var + IniFile: TMemIniFile; + ThemeIni: TMemIniFile; + Tekst: string; + Pet: integer; + B: boolean; + I, I2, I3: integer; + S: string; + Modes: PPSDL_Rect; + SR: TSearchRec; //Skin List Patch + + function GetFileName (S: String):String; + begin + //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); + Result := copy (S,0,Pos ('.ini',S)-1); + end; + +begin + GamePath := ExtractFilePath(ParamStr(0)); + + if (Params.ConfigFile <> '') then + try + IniFile := TMemIniFile.Create(Params.ConfigFile); + except + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + end + else + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + + // Name + for I := 0 to 11 do + Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + + // Templates for Names Mod + for I := 0 to 2 do + Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); + for Pet := 0 to High(IPlayers) do + if Tekst = IPlayers[Pet] then Ini.Players := Pet; + + // Difficulty + Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); + for Pet := 0 to High(IDifficulty) do + if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; + + // Language + Tekst := IniFile.ReadString('Game', 'Language', 'English'); + for Pet := 0 to High(ILanguage) do + if Tekst = ILanguage[Pet] then Ini.Language := Pet; + +// Language.ChangeLanguage(ILanguage[Ini.Language]); + + // Tabs + Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); + for Pet := 0 to High(ITabs) do + if Tekst = ITabs[Pet] then Ini.Tabs := Pet; + + //Tabs at Startup fix + Ini.Tabs_at_startup := Ini.Tabs; + + // Sorting + Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); + for Pet := 0 to High(ISorting) do + if Tekst = ISorting[Pet] then Ini.Sorting := Pet; + + // Debug + Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); + for Pet := 0 to High(IDebug) do + if Tekst = IDebug[Pet] then Ini.Debug := Pet; + + //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; + + // Screens + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + for Pet := 0 to High(IScreens) do + if Tekst = IScreens[Pet] then Ini.Screens := Pet; + + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + + // Resolution + SetLength(IResolution, 0); + + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + end; + + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + Ini.FullScreen := 0; + end; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do begin + S := IResolution[I]; + IResolution[I] := IResolution[High(IResolution)-I]; + IResolution[High(IResolution)-I] := S; + end; + + Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + for Pet := 0 to High(IResolution) do + if Tekst = IResolution[Pet] then Ini.Resolution := Pet; + + + // Resolution + Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); + for Pet := 0 to High(IDepth) do + if Tekst = IDepth[Pet] then Ini.Depth := Pet; + + // Texture Size + Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); + for Pet := 0 to High(ITextureSize) do + if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; + + // SingWindow + Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); + for Pet := 0 to High(ISingWindow) do + if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; + + // Oscilloscope + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); + for Pet := 0 to High(IOscilloscope) do + if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; + + // Spectrum + Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); + for Pet := 0 to High(ISpectrum) do + if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; + + // Spectrograph + Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); + for Pet := 0 to High(ISpectrograph) do + if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; + + // MovieSize + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); + for Pet := 0 to High(IMovieSize) do + if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; + + // MicBoost + Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); + for Pet := 0 to High(IMicBoost) do + if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; + + // ClickAssist + Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); + for Pet := 0 to High(IClickAssist) do + if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; + + // BeatClick + Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); + for Pet := 0 to High(IBeatClick) do + if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; + + // SavePlayback + Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); + for Pet := 0 to High(ISavePlayback) do + if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; + + // Threshold + Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); + for Pet := 0 to High(IThreshold) do + if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + + //Song Preview + Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); + for Pet := 0 to High(IPreviewVolume) do + if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; + + Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); + for Pet := 0 to High(IPreviewFading) do + if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; + + // Lyrics Font + Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); + for Pet := 0 to High(ILyricsFont) do + if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; + + // Lyrics Effect + Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); + for Pet := 0 to High(ILyricsEffect) do + if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; + + // Solmization + Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); + for Pet := 0 to High(ISolmization) do + if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; + + // Theme + + //Theme List Patch + + //I2 Saves the no of the Deluxe (Standard-) Theme + I2 := 0; + //I counts is the cur. Theme no + I := 0; + + SetLength(ITheme, 0); + writeln( 'Searching for Theme : '+ ThemePath + '*.ini' ); + FindFirst(ThemePath + '*.ini',faAnyFile,SR); + Repeat + writeln( SR.Name ); + + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SR.Name); + Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); + ThemeIni.Free; + + //if Deluxe Theme then save Themeno to I2 + if (Tekst = 'DELUXE') then + I2 := I; + + //Search for Skins for this Theme + for Pet := low(Skin.Skin) to high(Skin.Skin) do + begin + writeln( 'forloop' ); + if UpperCase(Skin.Skin[Pet].Theme) = Tekst then + begin + writeln( 'match' ); + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := GetFileName(SR.Name); + break; + end; + end; + + Inc(I); + Until FindNext(SR) <> 0; + FindClose(SR); + //Theme List Patch End } + + //No Theme Found + if (Length(ITheme)=0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); + Ini.Theme := 0; + for Pet := 0 to High(ITheme) do + if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; + + // Skin + Skin.onThemeChange; + Ini.SkinNo := 0; + + Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); + for Pet := 0 to High(ISkin) do + if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; + + // Color + Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); + for Pet := 0 to High(IColor) do + if Tekst = IColor[Pet] then Ini.Color := Pet; + + // Record - load ini list + SetLength(CardList, 0); + I := 1; + while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin + //Automatically Delete not Existing Sound Cards + S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); + //{ + B := False; + //Look for Soundcard + for I2 := 0 to High(Recording.SoundCard) do + begin + if (S = Trim(Recording.SoundCard[I2].Description)) then + begin + B := True; + Break; + end; + end; + + if B then + begin //} + I3 := Length(CardList); + SetLength(CardList, I3+1); + Ini.CardList[I3].Name := S; + Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); + Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); + Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); + end; + Inc(I); + end; + + // Record - append detected soundcards + for I := 0 to High(Recording.SoundCard) do + begin + B := False; + For I2 := 0 to High(CardList) do + begin //Search for Card in List + if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then + begin + B := True; + Break; + end; + end; + + //If not in List -> Add + If not B then + begin + I3 := Length(CardList); + SetLength(CardList, I3+1); + CardList[I3].Name := Trim(Recording.SoundCard[I].Description); + CardList[I3].Input := 0; + CardList[I3].ChannelL := 0; + CardList[I3].ChannelR := 0; + // default for new users + if (Length(CardList) = 1) then + CardList[I].ChannelL := 1; + end; + end; + + //Advanced Settings + + // LoadAnimation + Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); + for Pet := 0 to High(ILoadAnimation) do + if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; + + // ScreenFade + Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); + for Pet := 0 to High(IScreenFade) do + if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; + + // EffectSing + Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); + for Pet := 0 to High(IEffectSing) do + if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; + + // AskbeforeDel + Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); + for Pet := 0 to High(IAskbeforeDel) do + if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; + + // OnSongClick + Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); + for Pet := 0 to High(IOnSongClick) do + if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; + + // Linebonus + Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + + // PartyPopup + Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); + for Pet := 0 to High(IPartyPopup) do + if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; + + + // Joypad + Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); + for Pet := 0 to High(IJoypad) do + if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; + + // LCD + Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); + for Pet := 0 to High(ILPT) do + if Tekst = ILPT[Pet] then Ini.LPT := Pet; + + + // SongPath + if (Params.SongPath <> '') then + SongPath := IncludeTrailingPathDelimiter(Params.SongPath) + else + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + + Filename := IniFile.FileName; + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; + Tekst: string; + I: Integer; + S: String; +begin + //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin + + IniFile := TIniFile.Create(Filename); + + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); + + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); + + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); + + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); + + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); + + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); + + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); + + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); + + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); + + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); + + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); + + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); + + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); + + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); + + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); + + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); + + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); + + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); + + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); + + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); + + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); + + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); + + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); + + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); + + // Record + for I := 0 to High(CardList) do begin + S := IntToStr(I+1); + + Tekst := CardList[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + + Tekst := IntToStr(CardList[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelL); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + + Tekst := IntToStr(CardList[I].ChannelR); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; + + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + + //Advanced Settings + + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); + + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); + + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); + + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); + + IniFile.Free; + end; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + //Name + // Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); + + IniFile.Free; + end; +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 18bed197..06c4824a 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -86,12 +86,17 @@ var SongPath: string; LogPath: string; ThemePath: string; + SkinsPath: string; ScreenshotsPath: string; CoversPath: string; LanguagesPath: string; PluginPath: string; PlayListPath: string; + UserSongPath: string = ''; + UserCoversPath: string = ''; + UserPlaylistPath: string = ''; + OGL: Boolean; Done: Boolean; Event: TSDL_event; @@ -246,7 +251,7 @@ begin // Theme Log.BenchmarkStart(1); Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create('Themes\' + ITheme[Ini.Theme] + '.ini', Ini.Color); + Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Themes', 1); @@ -1023,17 +1028,24 @@ procedure InitializePaths; begin - GamePath := Platform.GetGamePath; - - initialize_path( LogPath , GamePath ); - initialize_path( SoundPath , GamePath + 'Sounds' + PathDelim ); - initialize_path( SongPath , GamePath + 'Songs' + PathDelim ); - initialize_path( ThemePath , GamePath + 'Themes' + PathDelim ); - initialize_path( ScreenshotsPath , GamePath + 'Screenshots' + PathDelim ); - initialize_path( CoversPath , GamePath + 'Covers' + PathDelim ); - initialize_path( LanguagesPath , GamePath + 'Languages' + PathDelim ); - initialize_path( PluginPath , GamePath + 'Plugins' + PathDelim ); - initialize_path( PlaylistPath , GamePath + 'Playlists' + PathDelim ); + initialize_path( LogPath , Platform.GetLogPath ); + initialize_path( SoundPath , Platform.GetGameSharedPath + 'Sounds' + PathDelim ); + initialize_path( ThemePath , Platform.GetGameSharedPath + 'Themes' + PathDelim ); + initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim ); + initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim ); + initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim ); + + initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim ); + + // Users Song Path .... + initialize_path( UserSongPath , Platform.GetGameUserPath + 'Songs' + PathDelim ); + initialize_path( UserCoversPath , Platform.GetGameUserPath + 'Covers' + PathDelim ); + initialize_path( UserPlaylistPath , Platform.GetGameUserPath + 'Playlists' + PathDelim ); + + // Shared Song Path .... + initialize_path( SongPath , Platform.GetGameSharedPath + 'Songs' + PathDelim ); + initialize_path( CoversPath , Platform.GetGameSharedPath + 'Covers' + PathDelim ); + initialize_path( PlaylistPath , Platform.GetGameSharedPath + 'Playlists' + PathDelim ); DecimalSeparator := ','; end; diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas index a06914d0..bdd6cf78 100644 --- a/Game/Code/Classes/UPlatform.pas +++ b/Game/Code/Classes/UPlatform.pas @@ -25,7 +25,17 @@ type TDirectoryEntryArray = Array of TDirectoryEntry; - TPlatform = class + IPlatform = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCA23DF}'] + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + end; + + TPlatform = class( TInterfacedOBject, IPlatform ) // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false @@ -34,11 +44,16 @@ type function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; virtual; - function GetGamePath : WideString; virtual; +// function GetGamePath : WideString; virtual; + function GetLogPath : WideString; virtual; + function GetGameSharedPath : WideString; virtual; + function GetGameUserPath : WideString; virtual; + end; + var - Platform : TPlatform; + Platform : IPlatform; implementation @@ -55,19 +70,37 @@ uses {$ENDIF} { TPlatform } - + +(* function TPlatform.GetGamePath: WideString; -begin - // Windows and Linux use this: - Result := ExtractFilePath(ParamStr(0)); -end; - +begin + // Windows and Linux use this: + Result := ExtractFilePath(ParamStr(0)); +end; +*) +function TPlatform.GetLogPath : WideString; +begin + result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatform.GetGameSharedPath : WideString; +begin + result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatform.GetGameUserPath : WideString; +begin + result := ExtractFilePath(ParamStr(0)); +end; + + + function TPlatform.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; -begin - // Linux and Mac don't check for running apps at the moment - Result := false; -end; - +begin + // Linux and Mac don't check for running apps at the moment + Result := false; +end; + initialization {$IFDEF MSWINDOWS} @@ -81,5 +114,5 @@ initialization {$ENDIF} finalization - freeandnil( Platform ); + Platform := nil; end. diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 8119346e..03e04560 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -13,13 +13,20 @@ uses Classes, UPlatform; type TPlatformLinux = class(TPlatform) + function get_homedir(): string; public Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; override; + + function GetLogPath : WideString; override; + function GetGameSharedPath : WideString; override; + function GetGameUserPath : WideString; override; end; implementation uses + libc, {$IFNDEF FPC_V220} oldlinux, {$ELSE} @@ -113,4 +120,35 @@ begin end; {$ENDIF} + +function TPlatformLinux.GetLogPath : WideString; +begin + result := '/var/log/UltraStarDeluxe/'; +end; + +function TPlatformLinux.GetGameSharedPath : WideString; +begin + result := '/usr/share/UltraStarDeluxe/'; +end; + +function TPlatformLinux.GetGameUserPath : WideString; +begin + result := get_homedir()+'/.UltraStarDeluxe/'; +end; + +function TPlatformLinux.get_homedir(): string; +var + pPasswdEntry : Ppasswd; + lUserName : String; +begin + pPasswdEntry := getpwuid( getuid() ); + result := pPasswdEntry^.pw_dir; +end; + +function TPlatformLinux.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; +begin + // Linux and Mac don't check for running apps at the moment + Result := false; +end; + end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 2237c22a..6a022153 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -42,7 +42,12 @@ var implementation -uses IniFiles, Classes, SysUtils, ULog, UIni; +uses IniFiles, + Classes, + SysUtils, + UMain, + ULog, + UIni; constructor TSkin.Create; begin @@ -54,13 +59,11 @@ end; procedure TSkin.LoadList; var SR: TSearchRec; -// SR2: TSearchRec; -// SLen: integer; begin - if FindFirst('Skins'+PathDelim+'*', faDirectory, SR) = 0 then begin + if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir('Skins'+PathDelim + SR.Name + PathDelim); + ParseDir(SkinsPath + SR.Name + PathDelim); until FindNext(SR) <> 0; end; // if FindClose(SR); @@ -69,13 +72,13 @@ end; procedure TSkin.ParseDir(Dir: string); var SR: TSearchRec; -// SLen: integer; begin if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin repeat + if (SR.Name <> '.') and (SR.Name <> '..') then LoadHeader(Dir + SR.Name); - //Log.LogError(SR.Name); + until FindNext(SR) <> 0; end; end; @@ -89,11 +92,12 @@ begin S := Length(Skin); SetLength(Skin, S+1); - Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); + + Skin[S].Path := IncludeTrailingBackslash(ExtractFileDir(FileName)); Skin[S].FileName := ExtractFileName(FileName); - Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); - Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); - Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); SkinIni.Free; end; @@ -105,17 +109,18 @@ var T: integer; S: integer; begin - S := GetSkinNumber(Name); + S := GetSkinNumber(Name); SkinPath := Skin[S].Path; - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); SL := TStringList.Create; SkinIni.ReadSection('Textures', SL); SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do begin - SkinTexture[T].Name := SL.Strings[T]; + for T := 0 to SL.Count-1 do + begin + SkinTexture[T].Name := SL.Strings[T]; SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); end; diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 3ac32dda..31db883d 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -265,7 +265,10 @@ begin BrowsePos := 0; // browse directories BrowseDir(SongPath); - + + if UserSongPath <> SongPath then + BrowseDir(UserSongPath); + //Set Correct SongArray Length SetLength(Song, BrowsePos); @@ -306,6 +309,7 @@ var i : Integer; Files : TDirectoryEntryArray; begin + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); for i := 0 to Length(Files)-1 do begin @@ -318,7 +322,8 @@ begin SLen := BrowsePos; Song[SLen].Path := Dir; - Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); +// Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); + Song[SLen].Folder := Copy(Dir, Length(Dir)+1, 10000); Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); Song[SLen].FileName := Files[i].Name; diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 1c731ce0..bfffb26a 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -807,6 +807,8 @@ begin create_theme_objects(); + writeln( 'TTheme.LoadTheme : '+ FileName ); + FileName := AdaptFilePaths( FileName ); if not FileExists(FileName) then @@ -828,7 +830,8 @@ begin ThemeIni := TMemIniFile.Create(FileName); {$ENDIF} - if ThemeIni.ReadString('Theme', 'Name', '') <> '' then begin + if ThemeIni.ReadString('Theme', 'Name', '') <> '' then + begin {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar'); Skin.SkinPath := 'Skins\' + Skin.SkinName + '\'; @@ -2218,93 +2221,93 @@ begin 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; - +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/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas index d63ce753..003e9ab0 100644 --- a/Game/Code/Classes/Ulazjpeg.pas +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -1,149 +1,151 @@ -{ Copyright (C) 2003 Mattias Gaertner - - This library is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published by - the Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License - for more details. - - You should have received a copy of the GNU Library General Public License - along with this library; if not, write to the Free Software Foundation, - Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -} -unit Ulazjpeg; - -{$mode objfpc}{$H+} -{$I switches.inc} - -interface - -uses - SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG; - -type - TJPEGQualityRange = TFPJPEGCompressionQuality; - TJPEGPerformance = TJPEGReadPerformance; - - TJPEGImage = class(TFPImageBitmap) - private - FPerformance: TJPEGPerformance; - FProgressiveEncoding: boolean; - FQuality: TJPEGQualityRange; - protected -{$IFDEF LAZARUS_V0924} - procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; -{$ELSE} - procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; -{$ENDIF} - procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; -{$IFDEF LAZARUS_V0924} - procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; -{$ELSE} - procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; -{$ENDIF} - public - constructor Create; override; - class function GetFileExtensions: string; override; - class function GetDefaultFPReader: TFPCustomImageReaderClass; override; - class function GetDefaultFPWriter: TFPCustomImageWriterClass; override; - public - property CompressionQuality: TJPEGQualityRange read FQuality write FQuality; - property ProgressiveEncoding: boolean read FProgressiveEncoding; - property Performance: TJPEGPerformance read FPerformance write FPerformance; - end; - -const - DefaultJPEGMimeType = 'image/jpeg'; - - -implementation - - -{ TJPEGImage } - -{$IFDEF LAZARUS_V0924} -procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); -{$ELSE} -procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); -{$ENDIF} -var - JPEGReader: TFPReaderJPEG; -begin - if ImgReader is TFPReaderJPEG then begin - JPEGReader:=TFPReaderJPEG(ImgReader); - JPEGReader.Performance:=Performance; -{$IFDEF LAZARUS_V0924} - JPEGReader.OnProgress:=@Progress; -{$ENDIF} - end; -{$IFDEF LAZARUS_V0924} - inherited InitFPImageReader(IntfImg, ImgReader); -{$ELSE} - inherited InitFPImageReader(ImgReader); -{$ENDIF} -end; - -procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); -var - JPEGReader: TFPReaderJPEG; -begin - if ImgReader is TFPReaderJPEG then begin - JPEGReader:=TFPReaderJPEG(ImgReader); - FProgressiveEncoding:=JPEGReader.ProgressiveEncoding; - end; - inherited FinalizeFPImageReader(ImgReader); -end; - -{$IFDEF LAZARUS_V0924} -procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); -{$ELSE} -procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); -{$ENDIF} -var - JPEGWriter: TFPWriterJPEG; -begin - if ImgWriter is TFPWriterJPEG then begin - JPEGWriter:=TFPWriterJPEG(ImgWriter); - if JPEGWriter<>nil then ; - JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; - JPEGWriter.CompressionQuality:=CompressionQuality; -{$IFDEF LAZARUS_V0924} - JPEGWriter.OnProgress:=@Progress; -{$ENDIF} - end; -{$IFDEF LAZARUS_V0924} - inherited InitFPImageWriter(IntfImg, ImgWriter); -{$ELSE} - inherited InitFPImageWriter(ImgWriter); -{$ENDIF} -end; - -class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; -begin - Result:=TFPReaderJPEG; -end; - -class function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass; -begin - Result:=TFPWriterJPEG; -end; - -constructor TJPEGImage.Create; -begin - inherited Create; - FPerformance:=jpBestQuality; - FProgressiveEncoding:=false; - FQuality:=75; -end; - -class function TJPEGImage.GetFileExtensions: string; -begin - Result:='jpg;jpeg'; -end; - -end. - +{ Copyright (C) 2003 Mattias Gaertner + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit Ulazjpeg; + +{$mode objfpc}{$H+} +{$I switches.inc} + +{$DEFINE LAZARUS_V0924} + +interface + +uses + SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG; + +type + TJPEGQualityRange = TFPJPEGCompressionQuality; + TJPEGPerformance = TJPEGReadPerformance; + + TJPEGImage = class(TFPImageBitmap) + private + FPerformance: TJPEGPerformance; + FProgressiveEncoding: boolean; + FQuality: TJPEGQualityRange; + protected +{$IFDEF LAZARUS_V0924} + procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; +{$ELSE} + procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; +{$ENDIF} + procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; +{$IFDEF LAZARUS_V0924} + procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; +{$ELSE} + procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; +{$ENDIF} + public + constructor Create; override; + class function GetFileExtensions: string; override; + class function GetDefaultFPReader: TFPCustomImageReaderClass; override; + class function GetDefaultFPWriter: TFPCustomImageWriterClass; override; + public + property CompressionQuality: TJPEGQualityRange read FQuality write FQuality; + property ProgressiveEncoding: boolean read FProgressiveEncoding; + property Performance: TJPEGPerformance read FPerformance write FPerformance; + end; + +const + DefaultJPEGMimeType = 'image/jpeg'; + + +implementation + + +{ TJPEGImage } + +{$IFDEF LAZARUS_V0924} +procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); +{$ELSE} +procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); +{$ENDIF} +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + JPEGReader.Performance:=Performance; +{$IFDEF LAZARUS_V0924} + JPEGReader.OnProgress:=@Progress; +{$ENDIF} + end; +{$IFDEF LAZARUS_V0924} + inherited InitFPImageReader(IntfImg, ImgReader); +{$ELSE} + inherited InitFPImageReader(ImgReader); +{$ENDIF} +end; + +procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + FProgressiveEncoding:=JPEGReader.ProgressiveEncoding; + end; + inherited FinalizeFPImageReader(ImgReader); +end; + +{$IFDEF LAZARUS_V0924} +procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); +{$ELSE} +procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); +{$ENDIF} +var + JPEGWriter: TFPWriterJPEG; +begin + if ImgWriter is TFPWriterJPEG then begin + JPEGWriter:=TFPWriterJPEG(ImgWriter); + if JPEGWriter<>nil then ; + JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; + JPEGWriter.CompressionQuality:=CompressionQuality; +{$IFDEF LAZARUS_V0924} + JPEGWriter.OnProgress:=@Progress; +{$ENDIF} + end; +{$IFDEF LAZARUS_V0924} + inherited InitFPImageWriter(IntfImg, ImgWriter); +{$ELSE} + inherited InitFPImageWriter(ImgWriter); +{$ENDIF} +end; + +class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; +begin + Result:=TFPReaderJPEG; +end; + +class function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass; +begin + Result:=TFPWriterJPEG; +end; + +constructor TJPEGImage.Create; +begin + inherited Create; + FPerformance:=jpBestQuality; + FProgressiveEncoding:=false; + FQuality:=75; +end; + +class function TJPEGImage.GetFileExtensions: string; +begin + Result:='jpg;jpeg'; +end; + +end. + -- cgit v1.2.3 From 8d367ca3e9d49fbac6798f5aad0be03f8e5cfeec Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 20 Dec 2007 20:12:38 +0000 Subject: removed hard-coded lazarus_v0924 define (why is it in there?) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@736 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/Ulazjpeg.pas | 2 -- 1 file changed, 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas index 003e9ab0..a5271a7e 100644 --- a/Game/Code/Classes/Ulazjpeg.pas +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -19,8 +19,6 @@ unit Ulazjpeg; {$mode objfpc}{$H+} {$I switches.inc} -{$DEFINE LAZARUS_V0924} - interface uses -- cgit v1.2.3 From d808dde8310ecfd659d36bfe1ba77e76ea43b6c0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Dec 2007 22:53:06 +0000 Subject: added -localpaths command line switch so we dont always have to use the packaged locations. ( profox ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@737 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommandLine.pas | 5 ++++- Game/Code/Classes/UPlatformLinux.pas | 16 +++++++++++++--- 2 files changed, 17 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index e99ee37a..86f822a4 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -56,6 +56,7 @@ var const cHelp = 'help'; cMediaInterfaces = 'showinterfaces'; + cUseLocalPaths = 'localpaths'; implementation @@ -93,7 +94,9 @@ begin writeln( '' ); writeln( ' '+s( 'Switch' ) +' : Purpose' ); writeln( ' ----------------------------------------------------------' ); - writeln( ' '+s( cMediaInterfaces ) + ' : Show in-use media interfaces' ); + writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' ); + writeln( ' '+s( cUseLocalPaths ) + #9 + ' : Use relative paths' ); + writeln( '' ); halt; diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 03e04560..0098baee 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -27,6 +27,7 @@ implementation uses libc, + uCommandLine, {$IFNDEF FPC_V220} oldlinux, {$ELSE} @@ -123,17 +124,26 @@ end; function TPlatformLinux.GetLogPath : WideString; begin - result := '/var/log/UltraStarDeluxe/'; + if FindCmdLineSwitch( cUseLocalPaths ) then + result := inherited + else + result := '/var/log/UltraStarDeluxe/'; end; function TPlatformLinux.GetGameSharedPath : WideString; begin - result := '/usr/share/UltraStarDeluxe/'; + if FindCmdLineSwitch( cUseLocalPaths ) then + result := inherited + else + result := '/usr/share/UltraStarDeluxe/'; end; function TPlatformLinux.GetGameUserPath : WideString; begin - result := get_homedir()+'/.UltraStarDeluxe/'; + if FindCmdLineSwitch( cUseLocalPaths ) then + result := inherited + else + result := get_homedir()+'/.UltraStarDeluxe/'; end; function TPlatformLinux.get_homedir(): string; -- cgit v1.2.3 From a00122fe60de966751b637477ac8e0a4fdcfbf4b Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Dec 2007 23:59:59 +0000 Subject: removed a bunch of debugging from usdx startup. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@738 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 4 ---- Game/Code/Classes/UIni.pas | 2 -- Game/Code/Classes/ULog.pas | 34 ++++++++++++++++------------------ Game/Code/Classes/UTexture.pas | 2 +- 4 files changed, 17 insertions(+), 25 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index e4f83b7a..274bf404 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -128,8 +128,6 @@ begin Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); - Log.LogError('Identifier: '+Identifier+' - '+ Value ); - //Check the Identifier (If Value is given) if (Length(Value) <> 0) then begin @@ -332,8 +330,6 @@ Result := False; //Reset LineNo FileLineNo := 0; - writeln( 'Assign File : ' + Song.Path + Song.FileName ); - //Open File and set File Pointer to the beginning AssignFile(SongFile, Song.Path + Song.FileName); diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 0e84c506..abbef723 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -415,10 +415,8 @@ begin //Search for Skins for this Theme for Pet := low(Skin.Skin) to high(Skin.Skin) do begin - writeln( 'forloop' ); if UpperCase(Skin.Skin[Pet].Theme) = Tekst then begin - writeln( 'match' ); SetLength(ITheme, Length(ITheme)+1); ITheme[High(ITheme)] := GetFileName(SR.Name); break; diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 50e9bf68..01eff5f4 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -189,8 +189,6 @@ begin FileErrorO := false; end; end; - {$DEFINE DEBUG} //How can i check if this is set in *.dpr file o0 - //If Debug => Write to Console Output {$IFDEF DEBUG} WriteLn('Error: ' + Text); {$ENDIF} @@ -230,7 +228,7 @@ begin //If Debug => Write to Console Output {$IFDEF DEBUG} - WriteLn(Log2 + ': ' + Log1); +// WriteLn(Log2 + ': ' + Log1); {$ENDIF} end; @@ -260,21 +258,21 @@ end; procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string); var f : TFileStream; -begin - f := nil; - - try - f := TFileStream.Create( filename, fmCreate); - f.Write( buf^, bufLength); - f.Free; - except - on e : Exception do begin - Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); - f.Free; - end; - end; -end; - +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/UTexture.pas b/Game/Code/Classes/UTexture.pas index 8701673e..f57c9c15 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -{$define blindydebug} +{$undefine blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From bb30a9bec3566db0a8a8a65a0afe6cf864cdeb11 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 22 Dec 2007 16:53:25 +0000 Subject: fixed a "typo" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@740 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f57c9c15..82dedf45 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -{$undefine blindydebug} +{$undef blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From d4ecb06978eafef8ea7aff79197d6869916389d9 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 22 Dec 2007 22:08:10 +0000 Subject: fixed screenshot problem git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@743 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 06c4824a..7c3ad9d4 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -448,7 +448,7 @@ Begin SDL_KEYDOWN: begin //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path - if (Event.key.keysym.sym = SDLK_SYSREQ) then + if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then Display.ScreenShot // popup hack... if there is a visible popup then let it handle input instead of underlying screen -- cgit v1.2.3 From 5f6141d2d49c280c5ae70332290f360272d07e35 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 27 Dec 2007 00:08:54 +0000 Subject: bug-fix: Tex_ScoreBG bounds were changed from [0..5] to [1..6] but Tex_ScoreBG[0] was used at several places in the code. This corrupted Tex_SingLineBonusBack[8].Name and caused a segmentation fault. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@745 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 1578 ++++++++++++++++++++-------------------- 1 file changed, 789 insertions(+), 789 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 32d7d304..3536d9d7 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,789 +1,789 @@ -unit UGraphic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - OpenGL12, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - - //Notes - Tex_Left: array[0..6] of TTexture; //rename to tex_note_left - Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid - Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - - Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left - Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - - //ScoreBG Texs - Tex_ScoreBG: array [1..6] of TTexture; - - //Score Screen Textures - Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; - - Tex_Score_Ratings : array [0..6] of TTexture; - -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_SzczytR = 0.8; - Skin_SzczytG = 0; - Skin_SzczytB = 0; - - Skin_SzczytLimitR = 0; - Skin_SzczytLimitG = 0.8; - Skin_SzczytLimitB = 0; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_LyricsT = 494; // 500 / 510 / 400 - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; -procedure UnLoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses UMain, - UIni, - UDisplay, - UCommandLine, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - {$IFDEF win32} - windows, - {$ENDIF} - Classes; - -procedure LoadFontTextures; -begin - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure LoadTextures; - - -var - P: integer; - R, G, B: real; - Col: integer; -begin - // zaladowanie tekstur - Log.LogStatus('Loading Textures', 'LoadTextures'); - - Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? - - Log.LogStatus('Loading Textures - A', 'LoadTextures'); - - // P1-6 - // TODO... do it once for each player... this is a bit crappy !! - // can we make it any better !? - for P := 1 to 6 do - begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - - Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); - Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); - Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); - - Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); - Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); - Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); - - Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); - Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); - Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); - end; - - Log.LogStatus('Loading Textures - B', 'LoadTextures'); - - Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0); - Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF); - Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); - - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); - Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); - Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); - //end Singbar Mod - - Log.LogStatus('Loading Textures - C', 'LoadTextures'); - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Case P of - 0: begin - R := 1; - G := 0; - B := 0; - end; - 1..3: begin - R := 1; - G := (P * 0.25); - B := 0; - end; - 4: begin - R := 1; - G := 1; - B := 0; - end; - 5..7: begin - R := 1-((P-4)*0.25); - G := 1; - B := 0; - end; - 8: begin - R := 0; - G := 1; - B := 0; - end; - End; - - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); - end; - -//## backgrounds for the scores ## - for P := 0 to 5 do begin - LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); - end; - - - Log.LogStatus('Loading Textures - D', 'LoadTextures'); - -// ###################### -// Score screen textures -// ###################### - -//## the bars that visualize the score ## - for P := 1 to 6 do begin -//NoteBar ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col); - Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col); -//LineBonus ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col); - Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col); -//GoldenNotes ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col); - Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col); - end; - -//## rating pictures that show a picture according to your rate ## - for P := 0 to 6 do begin - Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0); - end; - - Log.LogStatus('Loading Textures - Done', 'LoadTextures'); -end; - -procedure Initialize3D (Title: string); -var -// Icon: TIcon; -// Res: TResourceStream; - ISurface: PSDL_Surface; - Pixel: PByteArray; - I: Integer; -begin - Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); -// Log.BenchmarkStart(2); - - LoadOpenGL; - - Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then - begin - Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); - exit; - end; - - { //Load Icon - Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); - Icon := TIcon.Create; - Icon.LoadFromStream(Res); - Res.Free; - Icon. - //Create icon Surface - SDL_CreateRGBSurfaceFrom ( - SDL_SWSURFACE, - Icon.Width, - Icon.Height, - 32, - 128 or 64, - 32 or 16, - 8 or 4, - 2 or 1); - //SDL_BlitSurface( - - - SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} - - SDL_WM_SetCaption(PChar(Title), nil); - - InitializeScreen; - -// Log.BenchmarkEnd(2); -// Log.LogBenchmark('--> Setting Screen', 2); - - // ladowanie tekstur -// Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - Texture.Limit := 1024*1024; - -// LoadTextures; -// Log.BenchmarkEnd(2); -// Log.LogBenchmark('--> Loading Textures', 2); - -{ Log.BenchmarkStart(2); - Lyric:= TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); -} - -// Log.BenchmarkStart(2); - - Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); - Display := TDisplay.Create; - - Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D'); - SDL_EnableUnicode(1); -// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - -// Log.LogStatus('Loading Screens', 'Initialize3D'); -// Log.BenchmarkStart(3); - - Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); - LoadFontTextures(); - - // Show the Loading Screen ------------- - Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); - LoadLoadingScreen; - - - Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); - LoadTextures; // jb - - - - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar -// Mutex := SDL_CreateMutex; -// SDL_UnLockMutex(Mutex); - - // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will - // siehe dazu kommentar unten - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // das hier würde dann im ladethread ausgeführt - Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); - LoadScreens; - - - // TODO!!!!!!1 - // hier käme jetzt eine schleife, die - // * den ladescreen malt (ab und zu) - // * den "fortschritt" des ladescreens steuert - // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und - // * die texturen in die opengl lädt, sowie - // * dem ladethread signalisiert, dass der speicher für die textur - // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) - // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, - // dass er alles geladen hat fertig ist - // - // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche - // opengl funktionen aufzurufen, entsprechend mutexe verändert - // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, - // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... - - - //wait for loading thread to finish - // funktioniert so auch noch nicht - //SDL_WaitThread(LoadingThread, I); -// SDL_DestroyMutex(Mutex); - - Display.ActualScreen^.FadeTo( @ScreenMain ); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin -// InitializeScreen; -// LoadTextures; -// LoadScreens; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - {if ParamStr(1) = '-fsblack' then begin - W := 800; - H := 600; - end; - if ParamStr(1) = '-320x240' then begin - W := 320; - H := 240; - end; } - - If (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - - Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon'); - -// Okay it's possible to set the title bar / taskbar icon here -// it's working this way, but just if the bmp is in your exe folder - SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); -// SDL_SetRefreshrate(85); -// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - - {$ifndef win32} - // Todo : jb_linux remove this for linux... but helps for debugging - Ini.FullScreen := 0; - W := 800; - H := 600; - {$endif} - - {$IFDEF DARWIN} - // Todo : eddie: remove before realease - Ini.FullScreen := 0; - {$ENDIF} - - if (Ini.FullScreen = 0) and (Not Params.FullScreen) then - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) - end - else - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); - end; - - if (screen = nil) then - begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; - end; - - // clear screen once window is being shown - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; - - // zmienne - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - - Display.ActualScreen := @ScreenLoading; - - swapbuffers; - - ScreenLoading.Draw; - Display.Draw; - - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.ActualScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - ScreenPartyNewRound := TScreenPartyNewRound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); - ScreenPartyScore := TScreenPartyScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - -end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -procedure UnLoadScreens; -begin - freeandnil( ScreenMain ); - freeandnil( ScreenName ); - freeandnil( ScreenLevel); - freeandnil( ScreenSong ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSing ); - freeandnil( ScreenScore); - freeandnil( ScreenTop5 ); - freeandnil( ScreenOptions ); - freeandnil( ScreenOptionsGame ); - freeandnil( ScreenOptionsGraphics ); - freeandnil( ScreenOptionsSound ); - freeandnil( ScreenOptionsLyrics ); -// freeandnil( ScreenOptionsThemes ); - freeandnil( ScreenOptionsRecord ); - freeandnil( ScreenOptionsAdvanced ); - freeandnil( ScreenEditSub ); - freeandnil( ScreenEdit ); - freeandnil( ScreenEditConvert ); - freeandnil( ScreenOpen ); - freeandnil( ScreenSingModi ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSongJumpto); - freeandnil( ScreenPopupCheck ); - freeandnil( ScreenPopupError ); - freeandnil( ScreenPartyNewRound ); - freeandnil( ScreenPartyScore ); - freeandnil( ScreenPartyWin ); - freeandnil( ScreenPartyOptions ); - freeandnil( ScreenPartyPlayer ); - freeandnil( ScreenStatMain ); - freeandnil( ScreenStatDetail ); -end; - -end. +unit UGraphic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + + //ScoreBG Texs + Tex_ScoreBG: array [0..5] of TTexture; + + //Score Screen Textures + Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; + + Tex_Score_Ratings : array [0..6] of TTexture; + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; +procedure UnLoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + {$IFDEF win32} + windows, + {$ENDIF} + Classes; + +procedure LoadFontTextures; +begin + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + + Log.LogStatus('Loading Textures - A', 'LoadTextures'); + + // P1-6 + // TODO... do it once for each player... this is a bit crappy !! + // can we make it any better !? + for P := 1 to 6 do + begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + end; + + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + Log.LogStatus('Loading Textures - C', 'LoadTextures'); + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Case P of + 0: begin + R := 1; + G := 0; + B := 0; + end; + 1..3: begin + R := 1; + G := (P * 0.25); + B := 0; + end; + 4: begin + R := 1; + G := 1; + B := 0; + end; + 5..7: begin + R := 1-((P-4)*0.25); + G := 1; + B := 0; + end; + 8: begin + R := 0; + G := 1; + B := 0; + end; + End; + + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); + end; + +//## backgrounds for the scores ## + for P := 0 to 5 do begin + LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); + end; + + + Log.LogStatus('Loading Textures - D', 'LoadTextures'); + +// ###################### +// Score screen textures +// ###################### + +//## the bars that visualize the score ## + for P := 1 to 6 do begin +//NoteBar ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col); +//LineBonus ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col); +//GoldenNotes ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col); + end; + +//## rating pictures that show a picture according to your rate ## + for P := 0 to 6 do begin + Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0); + end; + + Log.LogStatus('Loading Textures - Done', 'LoadTextures'); +end; + +procedure Initialize3D (Title: string); +var +// Icon: TIcon; +// Res: TResourceStream; + ISurface: PSDL_Surface; + Pixel: PByteArray; + I: Integer; +begin + Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); +// Log.BenchmarkStart(2); + + LoadOpenGL; + + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then + begin + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); + exit; + end; + + { //Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + Icon. + //Create icon Surface + SDL_CreateRGBSurfaceFrom ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + //SDL_BlitSurface( + + + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} + + SDL_WM_SetCaption(PChar(Title), nil); + + InitializeScreen; + +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur +// Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + +// LoadTextures; +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Loading Textures', 2); + +{ Log.BenchmarkStart(2); + Lyric:= TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); +} + +// Log.BenchmarkStart(2); + + Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); + Display := TDisplay.Create; + + Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D'); + SDL_EnableUnicode(1); +// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + +// Log.LogStatus('Loading Screens', 'Initialize3D'); +// Log.BenchmarkStart(3); + + Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); + LoadFontTextures(); + + // Show the Loading Screen ------------- + Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); + LoadLoadingScreen; + + + Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); + LoadTextures; // jb + + + + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // das hier würde dann im ladethread ausgeführt + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); + LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + + + //wait for loading thread to finish + // funktioniert so auch noch nicht + //SDL_WaitThread(LoadingThread, I); +// SDL_DestroyMutex(Mutex); + + Display.ActualScreen^.FadeTo( @ScreenMain ); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + {if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + + Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon'); + +// Okay it's possible to set the title bar / taskbar icon here +// it's working this way, but just if the bmp is in your exe folder + SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + + {$ifndef win32} + // Todo : jb_linux remove this for linux... but helps for debugging + Ini.FullScreen := 0; + W := 800; + H := 600; + {$endif} + + {$IFDEF DARWIN} + // Todo : eddie: remove before realease + Ini.FullScreen := 0; + {$ENDIF} + + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL) + end + else + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end; + + if (screen = nil) then + begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + + Display.ActualScreen := @ScreenLoading; + + swapbuffers; + + ScreenLoading.Draw; + Display.Draw; + + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.ActualScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + +end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +procedure UnLoadScreens; +begin + freeandnil( ScreenMain ); + freeandnil( ScreenName ); + freeandnil( ScreenLevel); + freeandnil( ScreenSong ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSing ); + freeandnil( ScreenScore); + freeandnil( ScreenTop5 ); + freeandnil( ScreenOptions ); + freeandnil( ScreenOptionsGame ); + freeandnil( ScreenOptionsGraphics ); + freeandnil( ScreenOptionsSound ); + freeandnil( ScreenOptionsLyrics ); +// freeandnil( ScreenOptionsThemes ); + freeandnil( ScreenOptionsRecord ); + freeandnil( ScreenOptionsAdvanced ); + freeandnil( ScreenEditSub ); + freeandnil( ScreenEdit ); + freeandnil( ScreenEditConvert ); + freeandnil( ScreenOpen ); + freeandnil( ScreenSingModi ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSongJumpto); + freeandnil( ScreenPopupCheck ); + freeandnil( ScreenPopupError ); + freeandnil( ScreenPartyNewRound ); + freeandnil( ScreenPartyScore ); + freeandnil( ScreenPartyWin ); + freeandnil( ScreenPartyOptions ); + freeandnil( ScreenPartyPlayer ); + freeandnil( ScreenStatMain ); + freeandnil( ScreenStatDetail ); +end; + +end. -- cgit v1.2.3 From 08ac48400b9cd669ef80c9ed0f1acf57743d6875 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 27 Dec 2007 12:27:55 +0000 Subject: Added missing return-values (always true) to InitCore and LoadCore. Whiteshark: Please change this to the appropriate values. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@749 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index c150ff34..9718b2eb 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -376,6 +376,8 @@ begin //A little Test Hooks.AddSubscriber('Core/NewError', HookTest); + + result := true; end; //------------- @@ -384,6 +386,7 @@ end; Function TCore.InitCore: Boolean; begin //Dont Init s.th. atm. + result := true; end; //------------- -- cgit v1.2.3 From e4c30499349a0cc5b75fce7e59dc0a4abfa0a10e Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 27 Dec 2007 12:31:21 +0000 Subject: FileErrorO is set to true to early. Even if FileError couldn't be opened it will be set to true and hence usdx tries to close and unopened fileerror-stream later which results in a segmentation fault git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@750 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 01eff5f4..fc567d54 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -163,7 +163,7 @@ end; procedure TLog.LogError(Text: string); begin if Enabled AND (not FileErrorO) then begin - FileErrorO := true; + //FileErrorO := true; AssignFile(FileError, LogPath + 'Error.log'); {$I-} Rewrite(FileError); -- cgit v1.2.3 From e5bdcfc8e584d2867d0ad7995d18bd30c7874d1b Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 28 Dec 2007 11:46:04 +0000 Subject: New class-structure seperates decoders/input and playback. The files aren't used in usdx until they are stable so they will not conflict with the old structure. The older files (UAudio_Bass etc.) will be replaced then. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@752 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 600 ++++++++++++++++++++++ Game/Code/Classes/UAudioInput_Bass.pas | 286 +++++++++++ Game/Code/Classes/UAudioInput_Portaudio.pas | 420 ++++++++++++++++ Game/Code/Classes/UAudioPlayback_Bass.pas | 460 +++++++++++++++++ Game/Code/Classes/UAudioPlayback_Portaudio.pas | 664 +++++++++++++++++++++++++ 5 files changed, 2430 insertions(+) create mode 100644 Game/Code/Classes/UAudioDecoder_FFMpeg.pas create mode 100644 Game/Code/Classes/UAudioInput_Bass.pas create mode 100644 Game/Code/Classes/UAudioInput_Portaudio.pas create mode 100644 Game/Code/Classes/UAudioPlayback_Bass.pas create mode 100644 Game/Code/Classes/UAudioPlayback_Portaudio.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas new file mode 100644 index 00000000..54055454 --- /dev/null +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -0,0 +1,600 @@ +unit UAudioDecoder_FFMpeg; + +(******************************************************************************* + +This unit is primarily based upon - + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + + and tutorial03.c + + http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + +*******************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + SDL, + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ifndef win32} + libc, + {$endif} + {$ENDIF} + UIni, + UMain, + UThemes; + + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + firstPkt, + lastPkt : PAVPacketList; + nbPackets : integer; + size : integer; + mutex : PSDL_Mutex; + cond : PSDL_Cond; + quit : boolean; + + public + constructor Create(); + destructor Destroy(); override; + + function Put(pkt : PAVPacket): integer; + function Get(var pkt: TAVPacket; block: boolean): integer; + end; + +var + EOSPacket: TAVPacket; + +type + PAudioBuffer = ^TAudioBuffer; + TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; + +type + TFFMpegDecodeStream = class(TAudioDecodeStream) + private + status: TStreamStatus; + + EOS_Flag: boolean; // end-of-stream flag + + parseThread: PSDL_Thread; + packetQueue: TPacketQueue; + + // FFMpeg internal data + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + + // "static" vars for DecodeFrame + pkt : TAVPacket; + audio_pkt_data : PChar; + audio_pkt_size : integer; + + // "static" vars for AudioCallback + audio_buf_index : cardinal; + audio_buf_size : cardinal; + audio_buf : TAudioBuffer; + + function DecodeFrame(var buffer: TAudioBuffer; bufSize: integer): integer; + public + constructor Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); + destructor Destroy(); override; + + procedure Close(); override; + + function GetLength(): real; override; + function GetChannelCount(): cardinal; override; + function GetSampleRate(): cardinal; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function IsEOS(): boolean; override; + + function ReadData(Buffer: PChar; BufSize: integer): integer; override; + end; + +type + TAudioDecoder_FFMpeg = class( TInterfacedObject, IAudioDecoder ) + private + class function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; + public + function GetName: String; + + function InitializeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +function ParseAudio(streamPtr: Pointer): integer; cdecl; forward; + +var + singleton_AudioDecoderFFMpeg : IAudioDecoder; + + +{ TFFMpegDecodeStream } + +constructor TFFMpegDecodeStream.Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); +begin + inherited Create(); + + status := sStopped; + packetQueue := TPacketQueue.Create(); + + audio_pkt_data := nil; + audio_pkt_size := 0; + + audio_buf_index := 0; + audio_buf_size := 0; + + FillChar(pkt, sizeof(TAVPacket), #0); + + Self.pFormatCtx := pFormatCtx; + Self.pCodecCtx := pCodecCtx; + Self.pCodec := pCodec; + Self.ffmpegStreamID := ffmpegStreamID; + Self.ffmpegStream := ffmpegStream; + + EOS_Flag := false; + + parseThread := SDL_CreateThread(@ParseAudio, Self); +end; + +destructor TFFMpegDecodeStream.Destroy(); +begin + packetQueue.Free(); + //SDL_WaitThread(parseThread, nil); + inherited; +end; + +procedure TFFMpegDecodeStream.Close(); +begin + // Close the codec + avcodec_close(pCodecCtx); + + // Close the video file + av_close_input_file(pFormatCtx); + + // TODO: abort thread +end; + +function TFFMpegDecodeStream.GetLength(): real; +begin + result := pFormatCtx^.duration / AV_TIME_BASE; +end; + +function TFFMpegDecodeStream.GetChannelCount(): cardinal; +begin + result := pCodecCtx^.channels; +end; + +function TFFMpegDecodeStream.GetSampleRate(): cardinal; +begin + result := pCodecCtx^.sample_rate; +end; + +function TFFMpegDecodeStream.IsEOS(): boolean; +begin + result := EOS_Flag; +end; + + +function ParseAudio(streamPtr: Pointer): integer; cdecl; +var + packet: TAVPacket; + stream: TFFMpegDecodeStream; +begin + stream := TFFMpegDecodeStream(streamPtr); + + while (av_read_frame(stream.pFormatCtx, packet) >= 0) do + begin + //writeln( 'ffmpeg - av_read_frame' ); + + if (packet.stream_index = stream.ffmpegStreamID) then + begin + //writeln( 'packet_queue_put' ); + stream.packetQueue.put(@packet); + end + else + begin + av_free_packet(packet); + end; + end; + + //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); + + // signal end-of-stream + stream.packetQueue.put(@EOSPacket); + + result := 0; +end; + +function TFFMpegDecodeStream.DecodeFrame(var buffer: TAudioBuffer; bufSize: integer): integer; +var + len1, + data_size: integer; +begin + result := -1; + + if (EOS_Flag) then + exit; + + while true do + begin + while (audio_pkt_size > 0) do + begin + //writeln( 'got audio packet' ); + data_size := bufSize; + + // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + len1 := avcodec_decode_audio(pCodecCtx, @buffer, + data_size, audio_pkt_data, audio_pkt_size); + + //writeln('avcodec_decode_audio : ' + inttostr( len1 )); + + if(len1 < 0) then + begin + // if error, skip frame + //writeln( 'Skip audio frame' ); + audio_pkt_size := 0; + break; + end; + + Inc(audio_pkt_data, len1); + Dec(audio_pkt_size, len1); + + if (data_size <= 0) then + begin + // No data yet, get more frames + continue; + end; + + // We have data, return it and come back for more later + result := data_size; + exit; + end; + + if (pkt.data <> nil) then + begin + av_free_packet(pkt); + end; + + if (packetQueue.quit) then + exit; + + if (packetQueue.Get(pkt, true) < 0) then + exit; + + audio_pkt_data := PChar(pkt.data); + audio_pkt_size := pkt.size; + + // check for end-of-stream + if (audio_pkt_data = PChar(EOSPacket.data)) then + begin + // end-of-stream reached -> set EOS-flag + EOS_Flag := true; + // note: buffer is not (even partially) filled -> no data to return + exit; + end; + + //writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + end; +end; + +function TFFMpegDecodeStream.ReadData(Buffer : PChar; BufSize: integer): integer; +var + outStream : TFFMpegDecodeStream; + len1, + audio_size : integer; + pSrc : Pointer; + len : integer; +begin + len := BufSize; + + // end-of-stream reached + if (EOS_Flag) then + exit; + + while (len > 0) do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := DecodeFrame(audio_buf, sizeof(TAudioBuffer)); + //writeln('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //writeln( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(Buffer, pSrc , len1); + {$else} + memcpy(Buffer, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(PChar(Buffer), len1); + Inc(audio_buf_index, len1); + end; + + result := BufSize; +end; + +function TFFMpegDecodeStream.GetPosition(): real; +var + bytes: integer; +begin + Result := 0; +end; + +procedure TFFMpegDecodeStream.SetPosition(Time: real); +var + bytes: integer; +begin +end; + + +{ TAudioDecoder_FFMpeg } + +function TAudioDecoder_FFMpeg.GetName: String; +begin + result := 'FFMpeg_Decoder'; +end; + +function TAudioDecoder_FFMpeg.InitializeDecoder: boolean; +begin + //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFMpeg'); + + av_register_all(); + + // init end-of-stream package + av_init_packet(EOSPacket); + EOSPacket.data := Pointer(PChar('EOS')); + + result := true; +end; + +class function TAudioDecoder_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; +var + i : integer; + streamID: integer; + stream : PAVStream; +begin + // Find the first audio stream + streamID := -1; + + for i := 0 to pFormatCtx^.nb_streams-1 do + begin + //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); + stream := pFormatCtx^.streams[i]; + + if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then + begin + //Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); + streamID := i; + break; + end; + end; + + result := streamID; +end; + +function TAudioDecoder_FFMpeg.Open(const Filename: string): TAudioDecodeStream; +var + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + wanted_spec, + csIndex : integer; + stream : TFFMpegDecodeStream; +begin + result := nil; + + if (not FileExists(Filename)) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudio_FFMpeg'); + exit; + end; + + // Open audio file + if (av_open_input_file(pFormatCtx, PChar(Filename), nil, 0, nil) > 0) then + exit; + + // Retrieve stream information + if (av_find_stream_info(pFormatCtx) < 0) then + exit; + + dump_format(pFormatCtx, 0, pchar(Filename), 0); + + ffmpegStreamID := FindAudioStreamID(pFormatCtx); + if (ffmpegStreamID < 0) then + exit; + + //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + + ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; + pCodecCtx := ffmpegStream^.codec; + + pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); + if (pCodec = nil) then + begin + Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); + exit; + end; + + avcodec_open(pCodecCtx, pCodec); + //writeln( 'Opened the codec' ); + + stream := TFFMpegDecodeStream.Create(pFormatCtx, pCodecCtx, pCodec, + ffmpegStreamID, ffmpegStream); + + result := stream; +end; + + +{ TPacketQueue } + +constructor TPacketQueue.Create(); +begin + inherited; + + firstPkt := nil; + lastPkt := nil; + nbPackets := 0; + size := 0; + + mutex := SDL_CreateMutex(); + cond := SDL_CreateCond(); +end; + +destructor TPacketQueue.Destroy(); +begin + SDL_DestroyMutex(mutex); + SDL_DestroyCond(cond); + inherited; +end; + +function TPacketQueue.Put(pkt : PAVPacket): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + if (pkt <> @EOSPacket) then + if (av_dup_packet(pkt) < 0) then + exit; + + pkt1 := av_malloc(sizeof(TAVPacketList)); + if (pkt1 = nil) then + exit; + + pkt1^.pkt := pkt^; + pkt1^.next := nil; + + + SDL_LockMutex(Self.mutex); + try + + if (Self.lastPkt = nil) then + Self.firstPkt := pkt1 + else + Self.lastPkt^.next := pkt1; + + Self.lastPkt := pkt1; + inc(Self.nbPackets); + + //Writeln('Put: ' + inttostr(nbPackets)); + + Self.size := Self.size + pkt1^.pkt.size; + SDL_CondSignal(Self.cond); + + finally + SDL_UnlockMutex(Self.mutex); + end; + + result := 0; +end; + +function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + SDL_LockMutex(Self.mutex); + try + while true do + begin + if (quit) then + exit; + + pkt1 := Self.firstPkt; + + if (pkt1 <> nil) then + begin + Self.firstPkt := pkt1.next; + if (Self.firstPkt = nil) then + Self.lastPkt := nil; + dec(Self.nbPackets); + + //Writeln('Get: ' + inttostr(nbPackets)); + + Self.size := Self.size - pkt1^.pkt.size; + pkt := pkt1^.pkt; + av_free(pkt1); + + result := 1; + break; + end + else + if (not block) then + begin + result := 0; + break; + end + else + begin + SDL_CondWait(Self.cond, Self.mutex); + end; + end; + finally + SDL_UnlockMutex(Self.mutex); + end; +end; + + + +initialization + singleton_AudioDecoderFFMpeg := TAudioDecoder_FFMpeg.create(); + + //writeln( 'UAudioDecoder_FFMpeg - Register Decoder' ); + AudioManager.add( singleton_AudioDecoderFFMpeg ); + +finalization + AudioManager.Remove( singleton_AudioDecoderFFMpeg ); + + +end. diff --git a/Game/Code/Classes/UAudioInput_Bass.pas b/Game/Code/Classes/UAudioInput_Bass.pas new file mode 100644 index 00000000..9807ffc3 --- /dev/null +++ b/Game/Code/Classes/UAudioInput_Bass.pas @@ -0,0 +1,286 @@ +unit UAudioInput_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; + +type + TAudioInput_Bass = class( TInterfacedObject, IAudioInput) + private + public + function GetName: String; + + {IAudioInput interface} + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + end; + + TBassSoundCard = class(TGenericSoundCard) + RecordStream: HSTREAM; + end; + +var + singleton_AudioInputBass : IAudioInput; + + +function TAudioInput_Bass.GetName: String; +begin + result := 'BASS_Input'; +end; + +procedure TAudioInput_Bass.InitializeRecord; +var + device: integer; + Descr: string; + input: integer; + input2: integer; + InputName: PChar; + Flags: integer; + mic: array[0..15] of integer; + SC: integer; // soundcard + SCI: integer; // soundcard input + No: integer; + +function isDuplicate(Desc: String): Boolean; +var + I: Integer; +begin + Result := False; + //Check for Soundcard with same Description + For I := 0 to SC-1 do + begin + if (Recording.SoundCard[I].Description = Desc) then + begin + Result := True; + Break; + end; + end; +end; + +begin + with Recording do + begin + // checks for recording devices and puts them into an array + SetLength(SoundCard, 0); + + SC := 0; + Descr := BASS_RecordGetDeviceDescription(SC); + + while (Descr <> '') do + begin + //If there is another SoundCard with the Same ID, Search an available Name + if (IsDuplicate(Descr)) then + begin + No:= 1; //Count of SoundCards with same Name + Repeat + Inc(No) + Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); + + //Set Description + Descr := Descr + ' (' + InttoStr(No) + ')'; + end; + + SetLength(SoundCard, SC+1); + + // TODO: free object on termination + SoundCard[SC] := TBassSoundCard.Create(); + SoundCard[SC].Description := Descr; + + //Get Recording Inputs + SCI := 0; + BASS_RecordInit(SC); + + InputName := BASS_RecordGetInputName(SCI); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then + begin + InputName := 'Microphone'; + end; + {$ENDIF} + + SetLength(SoundCard[SC].Input, 1); + SoundCard[SC].Input[SCI].Name := InputName; + + // process each input + while (InputName <> nil) do + begin + Flags := BASS_RecordGetInput(SCI); + if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then + begin + SetLength(SoundCard[SC].Input, SCI+1); + SoundCard[SC].Input[SCI].Name := InputName; + end; + + //Set Mic Index + if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then + SoundCard[SC].MicInput := SCI; + + Inc(SCI); + InputName := BASS_RecordGetInputName(SCI); + end; + + BASS_RecordFree; + + Inc(SC); + Descr := BASS_RecordGetDeviceDescription(SC); + end; // while + end; // with Recording +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudioInput_Bass.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudioInput_Bass.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; Card: Cardinal): boolean; stdcall; +begin + Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); + Result := true; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudioInput_Bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: integer; + ErrorMsg: string; + bassSoundCard: TBassSoundCard; +begin + if not BASS_RecordInit(Card) then + begin + Error := BASS_ErrorGetCode; + ErrorMsg := IntToStr(Error); + if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; + if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; + if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; + if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; + Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); + Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); + end + else + begin + bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); + bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; + bassSoundCard.CaptureSoundRight := CaptureSoundRight; + + // capture in 44.1kHz/stereo/16bit and a 20ms callback period + bassSoundCard.RecordStream := + BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); + end; +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudioInput_Bass.StopCard(Card: byte); +begin + BASS_RecordSetDevice(Card); + BASS_RecordFree; +end; + + +initialization + singleton_AudioInputBass := TAudioInput_Bass.create(); + AudioManager.add( singleton_AudioInputBass ); + +finalization + AudioManager.Remove( singleton_AudioInputBass ); + +end. diff --git a/Game/Code/Classes/UAudioInput_Portaudio.pas b/Game/Code/Classes/UAudioInput_Portaudio.pas new file mode 100644 index 00000000..853fc35b --- /dev/null +++ b/Game/Code/Classes/UAudioInput_Portaudio.pas @@ -0,0 +1,420 @@ +unit UAudioInput_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + SysUtils, + portaudio, + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; +{ +type + TPaHostApiIndex = PaHostApiIndex; + TPaDeviceIndex = PaDeviceIndex; + PPaStream = ^PaStreamPtr; + PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; + TPaStreamCallbackFlags = PaStreamCallbackFlags; + TPaHostApiTypeId = PaHostApiTypeId; + PPaHostApiInfo = ^PaHostApiInfo; + PPaDeviceInfo = ^PaDeviceInfo; + TPaError = PaError; + TPaStreamParameters = PaStreamParameters; +} +type + TAudioInput_Portaudio = class( TInterfacedObject, IAudioInput ) + private + function GetPreferredApiIndex(): TPaHostApiIndex; + public + function GetName: String; + procedure InitializeRecord; + + procedure CaptureStart; + procedure CaptureStop; + + procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); + procedure StopCard(Card: byte); + end; + + TPortaudioSoundCard = class(TGenericSoundCard) + RecordStream: PPaStream; + DeviceIndex: TPaDeviceIndex; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +var + singleton_AudioInputPortaudio : IAudioInput; + +const + sampleRate: Double = 44100.; + +{* the default API used by Portaudio is the least common denominator + * and might lack efficiency. ApiPreferenceOrder defines the order of + * preferred APIs to use. The first API-type in the list is tried first. If it's + * not available the next is tried, ... + * If none of the preferred APIs was found the default API is used. + * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi + * as an array's only member if you do not have any preferences. + * paDefaultApi also terminates a preferences list but this is optional. + *} +const + paDefaultApi = -1; +var + ApiPreferenceOrder: +{$IF Defined(WIN32)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME + //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note1: Portmixer has no mixer support for paJACK at the moment + // Note2: Not tested, but ALSA might be better than OSS. + array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); +{$ELSEIF Defined(DARWIN)} + // Note: Not tested. + //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + +function TAudioInput_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudioInput_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; +begin + result := -1; + + // select preferred sound-API + for i:= 0 to High(ApiPreferenceOrder) do + begin + if(ApiPreferenceOrder[i] <> paDefaultApi) then begin + // check if API is available + result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(result >= 0) then + break; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then begin + result := Pa_GetDefaultHostApi(); + end; +end; + +// TODO: should be a function with boolean return type +procedure TAudioInput_Portaudio.InitializeRecord; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + inputCnt: integer; + inputName: string; + SC: integer; // soundcard + SCI: integer; // soundcard input + err: TPaError; + errMsg: string; + paSoundCard: TPortaudioSoundCard; + inputParams: TPaStreamParameters; + stream: PPaStream; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + {$ENDIF} +begin + // TODO: call Pa_Terminate() on termination + err := Pa_Initialize(); + if(err <> paNoError) then begin + Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + // result := false; + Exit; + end; + + apiIndex := GetPreferredApiIndex(); + apiInfo := Pa_GetHostApiInfo(apiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL + for i:= 0 to High(Recording.SoundCard) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + // current device is no input device -> skip + if(deviceInfo^.maxInputChannels <= 0) then + continue; + + // TODO: free object on termination + paSoundCard := TPortaudioSoundCard.Create(); + Recording.SoundCard[SC] := paSoundCard; + + // retrieve device-name + deviceName := deviceInfo^.name; + paSoundCard.Description := deviceName; + paSoundCard.DeviceIndex := deviceIndex; + + // setup desired input parameters + with inputParams do begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // check if device supports our input-format + err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); + if(err <> 0) then begin + // format not supported -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + // TODO: retry with mono if stereo is not supported + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + + err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); + if(err <> paNoError) then begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paSoundCard.Free(); + continue; + end; + + + {$IFDEF UsePortmixer} + + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + inputCnt := Px_GetNumInputSources(mixer); + SetLength(paSoundCard.Input, inputCnt); + + // get input names + for SCI := 0 to inputCnt-1 do + begin + inputName := Px_GetInputSourceName(mixer, SCI); + paSoundCard.Input[SCI].Name := inputName; + end; + + Px_CloseMixer(mixer); + + {$ELSE} // !UsePortmixer + + //Pa_StartStream(stream); + // TODO: check if callback was called (this problem may occur on some devices) + //Pa_StopStream(stream); + + Pa_CloseStream(stream); + + // create a standard input source + SetLength(paSoundCard.Input, 1); + paSoundCard.Input[0].Name := 'Standard'; + + {$ENDIF} + + // use default input source + paSoundCard.InputSelected := 0; + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(Recording.SoundCard, SC); + + Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); + + { + SoundCard[SC].InputSelected := Mic[Device]; + } +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudioInput_Portaudio.CaptureStart; +var + S: integer; + SC: integer; + PlayerLeft, PlayerRight: integer; + CaptureSoundLeft, CaptureSoundRight: TSound; +begin + for S := 0 to High(Recording.Sound) do + Recording.Sound[S].BufferLong[0].Clear; + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then begin + if (PlayerLeft > -1) then + CaptureSoundLeft := Recording.Sound[PlayerLeft] + else + CaptureSoundLeft := nil; + if (PlayerRight > -1) then + CaptureSoundRight := Recording.Sound[PlayerRight] + else + CaptureSoundRight := nil; + + CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); + end; + end; +end; + +// TODO: code is used by all IAudioInput implementors +// -> move to a common superclass (TAudioInput_Generic?) +procedure TAudioInput_Portaudio.CaptureStop; +var + SC: integer; + PlayerLeft: integer; + PlayerRight: integer; +begin + + for SC := 0 to High(Ini.CardList) do begin + PlayerLeft := Ini.CardList[SC].ChannelL-1; + PlayerRight := Ini.CardList[SC].ChannelR-1; + if PlayerLeft >= PlayersPlay then PlayerLeft := -1; + if PlayerRight >= PlayersPlay then PlayerRight := -1; + if (PlayerLeft > -1) or (PlayerRight > -1) then + StopCard(SC); + end; + +end; + +{* + * Portaudio input capture callback. + *} +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); + result := paContinue; +end; + +{* + * Start input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + * CaptureSoundLeft - sound(-buffer) used for left channel capture data + * CaptureSoundRight - sound(-buffer) used for right channel capture data + *} +procedure TAudioInput_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); +var + Error: TPaError; + ErrorMsg: string; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + paSoundCard.CaptureSoundLeft := CaptureSoundLeft; + paSoundCard.CaptureSoundRight := CaptureSoundRight; + + // get input latency info + deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); + + // set input stream parameters + with inputParams do begin + device := paSoundCard.DeviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); + Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(paSoundCard)); + if(Error <> paNoError) then begin + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); + //Halt; + end; + + paSoundCard.RecordStream := stream; + + // start capture + Error := Pa_StartStream(stream); + if(Error <> paNoError) then begin + Pa_CloseStream(stream); + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); + //Halt; + end; +end; + +{* + * Stop input-capturing on Soundcard specified by Card. + * Params: + * Card - soundcard index in Recording.SoundCard array + *} +procedure TAudioInput_Portaudio.StopCard(Card: byte); +var + stream: PPaStream; + paSoundCard: TPortaudioSoundCard; +begin + paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + stream := paSoundCard.RecordStream; + if(stream <> nil) then begin + Pa_StopStream(stream); + Pa_CloseStream(stream); + end; +end; + + +initialization + singleton_AudioInputPortaudio := TAudioInput_Portaudio.create(); + AudioManager.add( singleton_AudioInputPortaudio ); + +finalization + AudioManager.Remove( singleton_AudioInputPortaudio ); + +end. diff --git a/Game/Code/Classes/UAudioPlayback_Bass.pas b/Game/Code/Classes/UAudioPlayback_Bass.pas new file mode 100644 index 00000000..ee6b1ef9 --- /dev/null +++ b/Game/Code/Classes/UAudioPlayback_Bass.pas @@ -0,0 +1,460 @@ +unit UAudioPlayback_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + bass, + ULog, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ENDIF} + URecord, + UIni, + UMain, + UCommon, + UThemes; + +type + TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, + mpPaused, mpOpen); + +const + ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); + +type + TBassOutputStream = class(TAudioOutputStream) + Handle: HSTREAM; + + constructor Create(); overload; + constructor Create(stream: HSTREAM); overload; + end; + +type + TAudioPlayback_Bass = class( TInterfacedObject, IAudioPlayback) + private + MusicStream: HSTREAM; + + StartSoundStream: HSTREAM; + BackSoundStream: HSTREAM; + SwooshSoundStream: HSTREAM; + ChangeSoundStream: HSTREAM; + OptionSoundStream: HSTREAM; + ClickSoundStream: HSTREAM; + DrumSoundStream: HSTREAM; + HihatSoundStream: HSTREAM; + ClapSoundStream: HSTREAM; + ShuffleSoundStream: HSTREAM; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + Loaded: boolean; + Loop: boolean; + + public + function GetName: String; + + {IAudioOutput interface} + + procedure InitializePlayback; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + + function Open(Name: string): boolean; // true if succeed + + procedure Rewind; + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function GetPosition: real; + procedure SetPosition(Time: real); + + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + function LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; + + //Equalizer + function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + end; + +var + singleton_AudioPlaybackBass : IAudioPlayback; + + +constructor TBassOutputStream.Create(); +begin + inherited; +end; + +constructor TBassOutputStream.Create(stream: HSTREAM); +begin + Create(); + Handle := stream; +end; + + +function TAudioPlayback_Bass.GetName: String; +begin + result := 'BASS_Playback'; +end; + +procedure TAudioPlayback_Bass.InitializePlayback; +var + Pet: integer; + S: integer; +begin +// Log.BenchmarkStart(4); +// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + Loaded := false; + Loop := false; + + if not BASS_Init(1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'Error'); + Exit; + end; + +// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer +// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); +// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + +// Log.LogStatus('Loading Sounds', 'Music Initialize'); + +// Log.BenchmarkStart(4); + LoadSoundFromFile(StartSoundStream, SoundPath + 'Common Start.mp3'); + LoadSoundFromFile(BackSoundStream, SoundPath + 'Common Back.mp3'); + LoadSoundFromFile(SwooshSoundStream, SoundPath + 'menu swoosh.mp3'); + LoadSoundFromFile(ChangeSoundStream, SoundPath + 'select music change music 50.mp3'); + LoadSoundFromFile(OptionSoundStream, SoundPath + 'option change col.mp3'); + LoadSoundFromFile(ClickSoundStream, SoundPath + 'rimshot022b.mp3'); + +// LoadSoundFromFile(DrumSoundStream, SoundPath + 'bassdrumhard076b.mp3'); +// LoadSoundFromFile(HihatSoundStream, SoundPath + 'hihatclosed068b.mp3'); +// LoadSoundFromFile(ClapSoundStream, SoundPath + 'claps050b.mp3'); + +// LoadSoundFromFile(ShuffleSoundStream, SoundPath + 'Shuffle.mp3'); + +// Log.BenchmarkEnd(4); +// Log.LogBenchmark('--> Loading Sounds', 4); +end; + +procedure TAudioPlayback_Bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudioPlayback_Bass.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + //Set Volume + BASS_ChannelSetAttributes (MusicStream, -1, Volume, -101); +end; + +procedure TAudioPlayback_Bass.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TAudioPlayback_Bass.Open(Name: string): boolean; +begin + Loaded := false; + if FileExists(Name) then + begin + MusicStream := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + + Loaded := true; + //Set Max Volume + SetMusicVolume (100); + end; + + Result := Loaded; +end; + +procedure TAudioPlayback_Bass.Rewind; +begin + if Loaded then begin + end; +end; + +procedure TAudioPlayback_Bass.SetPosition(Time: real); +var + bytes: integer; +begin + bytes := BASS_ChannelSeconds2Bytes(MusicStream, Time); + BASS_ChannelSetPosition(MusicStream, bytes); +end; + +procedure TAudioPlayback_Bass.Play; +begin + if Loaded then + begin + if Loop then + BASS_ChannelPlay(MusicStream, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class + + BASS_ChannelPlay(MusicStream, False); // for setting position before playing + end; +end; + +procedure TAudioPlayback_Bass.Pause; //Pause Mod +begin + if Loaded then begin + BASS_ChannelPause(MusicStream); // Pauses Song + end; +end; + +procedure TAudioPlayback_Bass.Stop; +begin + Bass_ChannelStop(MusicStream); +end; + +procedure TAudioPlayback_Bass.Close; +begin + Bass_StreamFree(MusicStream); +end; + +function TAudioPlayback_Bass.Length: real; +var + bytes: integer; +begin + Result := 60; + + bytes := BASS_ChannelGetLength(MusicStream); + Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); +end; + +function TAudioPlayback_Bass.getPosition: real; +var + bytes: integer; +begin + Result := 0; + + bytes := BASS_ChannelGetPosition(MusicStream); + Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); +end; + +function TAudioPlayback_Bass.Finished: boolean; +begin + Result := false; + + if BASS_ChannelIsActive(MusicStream) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +end; + +procedure TAudioPlayback_Bass.PlayStart; +begin + BASS_ChannelPlay(StartSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayBack; +begin + BASS_ChannelPlay(BackSoundStream, True);// then +end; + +procedure TAudioPlayback_Bass.PlaySwoosh; +begin + BASS_ChannelPlay(SwooshSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayChange; +begin + BASS_ChannelPlay(ChangeSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayOption; +begin + BASS_ChannelPlay(OptionSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayClick; +begin + BASS_ChannelPlay(ClickSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayDrum; +begin + BASS_ChannelPlay(DrumSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayHihat; +begin + BASS_ChannelPlay(HihatSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayClap; +begin + BASS_ChannelPlay(ClapSoundStream, True); +end; + +procedure TAudioPlayback_Bass.PlayShuffle; +begin + BASS_ChannelPlay(ShuffleSoundStream, True); +end; + +procedure TAudioPlayback_Bass.StopShuffle; +begin + BASS_ChannelStop(ShuffleSoundStream); +end; + +function TAudioPlayback_Bass.LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; +var + L: Integer; +begin + if FileExists(Name) then + begin + Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + try + stream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); + + //Add CustomSound + L := High(CustomSounds) + 1; + SetLength (CustomSounds, L + 1); + CustomSounds[L].Filename := Name; + CustomSounds[L].Stream := TBassOutputStream.Create(stream); + except + Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); + end; + end + else + begin + Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); + exit; + end; +end; + +//Equalizer +function TAudioPlayback_Bass.GetFFTData: TFFTData; +var + Data: TFFTData; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(MusicStream, @Result, BASS_DATA_FFT512); +end; + +{* + * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. + * Returns the number of frames (= stereo/mono sample) + *} +function TAudioPlayback_Bass.GetPCMData(var data: TPCMData): Cardinal; +var + info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetInfo(MusicStream, info); + ZeroMemory(@data, sizeof(TPCMData)); + + if (info.chans = 1) then + begin + // mono file -> add stereo channel + { + nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); + // interleave data + //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); + } + result := 0; + end + else + begin + // stereo file + nBytes := BASS_ChannelGetData(MusicStream, @data, sizeof(TPCMData)); + end; + if(nBytes <= 0) then + result := 0 + else + result := nBytes div sizeof(TPCMStereoSample); +end; + +function TAudioPlayback_Bass.LoadCustomSound(const Filename: String): Cardinal; +var + S: hStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + if LoadSoundFromFile(S, SoundPath + Filename) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudioPlayback_Bass.PlayCustomSound(const Index: Cardinal ); +begin + if Index <= High(CustomSounds) then + with CustomSounds[Index].Stream as TBassOutputStream do + begin + BASS_ChannelPlay(Handle, True); + end; +end; + + +initialization + singleton_AudioPlaybackBass := TAudioPlayback_Bass.create(); + AudioManager.add( singleton_AudioPlaybackBass ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackBass ); + +end. diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas new file mode 100644 index 00000000..36bebc8a --- /dev/null +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -0,0 +1,664 @@ +unit UAudioPlayback_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses Classes, + SysUtils, + UMusic; + +implementation + +uses + {$IFDEF LAZARUS} + lclintf, + {$ifndef win32} + libc, + {$endif} + {$ENDIF} + portaudio, + ULog, + UIni, + UMain; + +type + TPortaudioPlaybackStream = class(TAudioPlaybackStream) + private + status: TStreamStatus; + Loaded: boolean; + Loop: boolean; + public + decodeStream: TAudioDecodeStream; + + constructor Create(decodeStream: TAudioDecodeStream); + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure Close(); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; + + function ReadData(Buffer: PChar; BufSize: integer): integer; + + function IsLoaded(): boolean; + end; + +type + TAudioMixerStream = class + private + activeStreams: TList; + public + constructor Create(); + destructor Destroy(); override; + procedure AddStream(stream: TAudioPlaybackStream); + procedure RemoveStream(stream: TAudioPlaybackStream); + function ReadData(Buffer: PChar; BufSize: integer): integer; + end; + +type + TAudioPlayback_Portaudio = class( TInterfacedObject, IAudioPlayback ) + private + MusicStream: TPortaudioPlaybackStream; + + StartSoundStream: TPortaudioPlaybackStream; + BackSoundStream: TPortaudioPlaybackStream; + SwooshSoundStream: TPortaudioPlaybackStream; + ChangeSoundStream: TPortaudioPlaybackStream; + OptionSoundStream: TPortaudioPlaybackStream; + ClickSoundStream: TPortaudioPlaybackStream; + DrumSoundStream: TPortaudioPlaybackStream; + HihatSoundStream: TPortaudioPlaybackStream; + ClapSoundStream: TPortaudioPlaybackStream; + ShuffleSoundStream: TPortaudioPlaybackStream; + + //Custom Sounds + CustomSounds: array of TCustomSoundEntry; + + mixerStream: TAudioMixerStream; + paStream: PPaStream; + public + FrameSize: integer; + + function GetName: String; + + function InitializePortaudio(): boolean; + function StartPortaudioStream(): boolean; + + procedure InitializePlayback(); + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Filename: string): boolean; // true if succeed + function Load(Filename: string): TPortaudioPlaybackStream; + procedure Rewind; + procedure SetPosition(Time: real); + procedure Play; + procedure Pause; //Pause Mod + + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function GetPosition: real; + procedure PlayStart; + procedure PlayBack; + procedure PlaySwoosh; + procedure PlayChange; + procedure PlayOption; + procedure PlayClick; + procedure PlayDrum; + procedure PlayHihat; + procedure PlayClap; + procedure PlayShuffle; + procedure StopShuffle; + + //Equalizer + function GetFFTData: TFFTData; + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + //Custom Sounds + function LoadCustomSound(const Filename: String): Cardinal; + procedure PlayCustomSound(const Index: Cardinal ); + end; + + +function AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; forward; + +var + singleton_AudioPlaybackPortaudio : IAudioPlayback; + + +{ TAudioMixerStream } + +constructor TAudioMixerStream.Create(); +begin + activeStreams := TList.Create; +end; + +destructor TAudioMixerStream.Destroy(); +begin + activeStreams.Free; +end; + +procedure TAudioMixerStream.AddStream(stream: TAudioPlaybackStream); +begin + // check if stream is already in list to avoid duplicates + if (activeStreams.IndexOf(Pointer(stream)) = -1) then + activeStreams.Add(Pointer(stream)); +end; + +procedure TAudioMixerStream.RemoveStream(stream: TAudioPlaybackStream); +begin + activeStreams.Remove(Pointer(stream)); +end; + +function TAudioMixerStream.ReadData(Buffer: PChar; BufSize: integer): integer; +var + i: integer; + stream: TPortaudioPlaybackStream; + dataAvailable: boolean; +begin + dataAvailable := false; + + // search for playing stream + if (activeStreams.Count > 0) then + begin + for i := 0 to activeStreams.Count-1 do + begin + stream := TPortaudioPlaybackStream(activeStreams[i]); + if (stream.getStatus = sPlaying) then + begin + dataAvailable := true; + break; + end; + end; + + // fetch data from current stream + if (dataAvailable) then + begin + result := stream.ReadData(Buffer, BufSize); + end; + end; + + // return silence + if ((not dataAvailable) or (result = -1)) then + begin + FillChar(Buffer^, BufSize, 0); + result := BufSize; + end; +end; + + +{ TPortaudioPlaybackStream } + +constructor TPortaudioPlaybackStream.Create(decodeStream: TAudioDecodeStream); +begin + inherited Create(); + status := sStopped; + if (decodeStream <> nil) then + begin + Self.decodeStream := decodeStream; + Loaded := true; + end; +end; + +procedure TPortaudioPlaybackStream.Play(); +begin + status := sPlaying; +end; + +procedure TPortaudioPlaybackStream.Pause(); +begin + status := sPaused; +end; + +procedure TPortaudioPlaybackStream.Stop(); +begin + status := sStopped; +end; + +procedure TPortaudioPlaybackStream.Close(); +begin + Stop(); +end; + +function TPortaudioPlaybackStream.IsLoaded(): boolean; +begin + result := Loaded; +end; + +function TPortaudioPlaybackStream.GetLoop(): boolean; +begin + result := Loop; +end; + +procedure TPortaudioPlaybackStream.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TPortaudioPlaybackStream.GetLength(): real; +begin + result := decodeStream.Length; +end; + +function TPortaudioPlaybackStream.GetStatus(): TStreamStatus; +begin + result := status; +end; + +function TPortaudioPlaybackStream.ReadData(Buffer: PChar; BufSize: integer): integer; +begin + result := decodeStream.ReadData(Buffer, BufSize); + // end-of-stream reached -> stop playback + if (decodeStream.EOS) then + begin + status := sStopped; + end; +end; + + +{ TAudioPlayback_Portaudio } + +function AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + playback : TAudioPlayback_Portaudio; + playbackStream : TPortaudioPlaybackStream; + decodeStream : TAudioDecodeStream; +begin + playback := TAudioPlayback_Portaudio(userData); + with playback do + begin + mixerStream.ReadData(output, frameCount * FrameSize); + end; + result := paContinue; +end; + + +function TAudioPlayback_Portaudio.GetName: String; +begin + result := 'Portaudio_Playback'; +end; + +function TAudioPlayback_Portaudio.InitializePortaudio(): boolean; +var + paApi : TPaHostApiIndex; + paApiInfo : PPaHostApiInfo; + paOutParams : TPaStreamParameters; + paOutDevice : TPaDeviceIndex; + paOutDeviceInfo : PPaDeviceInfo; + err : TPaError; +begin + result := false; + + Pa_Initialize(); + + // FIXME: determine automatically + {$IFDEF WIN32} + paApi := Pa_HostApiTypeIdToHostApiIndex(paDirectSound); + {$ELSE} + paApi := Pa_HostApiTypeIdToHostApiIndex(paALSA); + {$ENDIF} + if (paApi < 0) then + begin + Log.LogStatus('Pa_HostApiTypeIdToHostApiIndex: '+Pa_GetErrorText(paApi), 'UAudioPlayback_Portaudio'); + exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApi); + paOutDevice := paApiInfo^.defaultOutputDevice; + paOutDeviceInfo := Pa_GetDeviceInfo(paOutDevice); + + with paOutParams do begin + device := paOutDevice; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := paOutDeviceInfo^.defaultLowOutputLatency; + hostApiSpecificStreamInfo := nil; + end; + + FrameSize := 2 * sizeof(Smallint); + + err := Pa_OpenStream(paStream, nil, @paOutParams, 44100, + paFramesPerBufferUnspecified, + paNoFlag, @AudioCallback, Self); + if(err <> paNoError) then begin + Log.LogStatus('Pa_OpenStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); + exit; + end; + + Log.LogStatus('Opened audio device', 'UAudioPlayback_Portaudio'); + + result := true; +end; + +function TAudioPlayback_Portaudio.StartPortaudioStream(): boolean; +var + err: TPaError; +begin + result := false; + + 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.InitializePlayback; +begin + Log.LogStatus('InitializePlayback', 'UAudioPlayback_Portaudio'); + + InitializePortaudio(); + mixerStream := TAudioMixerStream.Create; + + StartSoundStream := Load(SoundPath + 'Common start.mp3'); + BackSoundStream := Load(SoundPath + 'Common back.mp3'); + SwooshSoundStream := Load(SoundPath + 'menu swoosh.mp3'); + ChangeSoundStream := Load(SoundPath + 'select music change music 50.mp3'); + OptionSoundStream := Load(SoundPath + 'option change col.mp3'); + ClickSoundStream := Load(SoundPath + 'rimshot022b.mp3'); + +// DrumSoundStream := Load(SoundPath + 'bassdrumhard076b.mp3'); +// HihatSoundStream := Load(SoundPath + 'hihatclosed068b.mp3'); +// ClapSoundStream := Load(SoundPath + 'claps050b.mp3'); + +// ShuffleSoundStream := Load(SoundPath + 'Shuffle.mp3'); + + StartPortaudioStream(); +end; + + +procedure TAudioPlayback_Portaudio.SetVolume(Volume: integer); +begin + //New: Sets Volume only for this Application +(* + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +*) +end; + +procedure TAudioPlayback_Portaudio.SetMusicVolume(Volume: Integer); +begin + //Max Volume Prevention + if Volume > 100 then + Volume := 100; + + if Volume < 0 then + Volume := 0; + + //Set Volume +// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); +end; + +procedure TAudioPlayback_Portaudio.SetLoop(Enabled: boolean); +begin + MusicStream.SetLoop(Enabled); +end; + +function TAudioPlayback_Portaudio.Open(Filename: string): boolean; +var + decodeStream: TAudioDecodeStream; +begin + decodeStream := AudioDecoder.Open(Filename); + MusicStream := TPortaudioPlaybackStream.Create(decodeStream); + + if(MusicStream.IsLoaded()) then + begin + //Set Max Volume + SetMusicVolume(100); + end; + + Result := MusicStream.IsLoaded(); +end; + +procedure TAudioPlayback_Portaudio.Rewind; +begin + SetPosition(0); +end; + +procedure TAudioPlayback_Portaudio.SetPosition(Time: real); +var + bytes: integer; +begin + if (MusicStream.IsLoaded) then + begin + MusicStream.SetPosition(Time); + end; +end; + +procedure TAudioPlayback_Portaudio.Play; +begin + if (MusicStream <> nil) then + if (MusicStream.IsLoaded()) then + begin + if (MusicStream.GetLoop()) then + begin + end; + // start from beginning... + // actually bass itself does not loop, nor does this TAudio_FFMpeg Class + MusicStream.Play(); + end; +end; + +procedure TAudioPlayback_Portaudio.Pause; //Pause Mod +begin + if (MusicStream <> nil) then + if (MusicStream.IsLoaded()) then begin + MusicStream.Pause(); // Pauses Song + end; +end; + +procedure TAudioPlayback_Portaudio.Stop; +begin + if MusicStream <> nil then + MusicStream.Stop(); +end; + +procedure TAudioPlayback_Portaudio.Close; +begin + if MusicStream <> nil then + MusicStream.Close(); +end; + +function TAudioPlayback_Portaudio.Length: real; +begin + Result := 0; + if assigned( MusicStream ) then + begin + Result := MusicStream.GetLength(); + end; +end; + +function TAudioPlayback_Portaudio.getPosition: real; +var + bytes: integer; +begin + Result := 0; + +(* + bytes := BASS_ChannelGetPosition(BASS); + Result := BASS_ChannelBytes2Seconds(BASS, bytes); +*) +end; + +function TAudioPlayback_Portaudio.Finished: boolean; +begin + Result := false; + +(* + if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then + begin + Result := true; + end; +*) +end; + +procedure TAudioPlayback_Portaudio.PlayStart; +begin + if StartSoundStream <> nil then + StartSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayBack; +begin + if BackSoundStream <> nil then + BackSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlaySwoosh; +begin + if SwooshSoundStream <> nil then + SwooshSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayChange; +begin + if ChangeSoundStream <> nil then + ChangeSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayOption; +begin + if OptionSoundStream <> nil then + OptionSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayClick; +begin + if ClickSoundStream <> nil then + ClickSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayDrum; +begin + if DrumSoundStream <> nil then + DrumSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayHihat; +begin + if HihatSoundStream <> nil then + HihatSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayClap; +begin + if ClapSoundStream <> nil then + ClapSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.PlayShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.StopShuffle; +begin + if ShuffleSoundStream <> nil then + ShuffleSoundStream.Stop(); +end; + +//Equalizer +function TAudioPlayback_Portaudio.GetFFTData: TFFTData; +var + data: TFFTData; +begin + //Get Channel Data Mono and 256 Values +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); + result := data; +end; + +// Interface for Visualizer +function TAudioPlayback_Portaudio.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + +function TAudioPlayback_Portaudio.Load(Filename: string): TPortaudioPlaybackStream; +var + decodeStream : TAudioDecodeStream; + playbackStream : TPortaudioPlaybackStream; + csIndex : integer; +begin + result := nil; + + decodeStream := AudioDecoder.Open(Filename); + if (decodeStream = nil) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudioPlayback_Portaudio'); + exit; + end; + + playbackStream := TPortaudioPlaybackStream.Create(decodeStream); + mixerStream.AddStream(playbackStream); + + //Add CustomSound + csIndex := High(CustomSounds) + 1; + SetLength(CustomSounds, csIndex + 1); + CustomSounds[csIndex].Filename := Filename; + CustomSounds[csIndex].Stream := playbackStream; + + result := playbackStream; +end; + +function TAudioPlayback_Portaudio.LoadCustomSound(const Filename: String): Cardinal; +var + S: TAudioPlaybackStream; + I: Integer; + F: String; +begin + //Search for Sound in already loaded Sounds + F := UpperCase(SoundPath + FileName); + For I := 0 to High(CustomSounds) do + begin + if (UpperCase(CustomSounds[I].Filename) = F) then + begin + Result := I; + Exit; + end; + end; + + S := Load(SoundPath + Filename); + if (S <> nil) then + Result := High(CustomSounds) + else + Result := 0; +end; + +procedure TAudioPlayback_Portaudio.PlayCustomSound(const Index: Cardinal ); +begin + if (Index <= High(CustomSounds)) then + CustomSounds[Index].Stream.Play(); +end; + + + +initialization + singleton_AudioPlaybackPortaudio := TAudioPlayback_Portaudio.create(); + AudioManager.add( singleton_AudioPlaybackPortaudio ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackPortaudio ); + + +end. -- cgit v1.2.3 From 4a0e50ba0cc5bd835aaf942b65149e9613aad86e Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 28 Dec 2007 13:08:55 +0000 Subject: experimental positioning support added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@753 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioPlayback_Portaudio.pas | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index 36bebc8a..c2694e6d 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -46,9 +46,12 @@ type function GetLength(): real; override; function GetStatus(): TStreamStatus; override; - function ReadData(Buffer: PChar; BufSize: integer): integer; - function IsLoaded(): boolean; + + // functions delegated to the decode stream + function GetPosition: real; + procedure SetPosition(Time: real); + function ReadData(Buffer: PChar; BufSize: integer): integer; end; type @@ -269,6 +272,16 @@ begin end; end; +function TPortaudioPlaybackStream.GetPosition: real; +begin + result := decodeStream.Position; +end; + +procedure TPortaudioPlaybackStream.SetPosition(Time: real); +begin + decodeStream.Position := Time; +end; + { TAudioPlayback_Portaudio } -- cgit v1.2.3 From 77f3d0dcae9fe77a8d3cef1825756741b6d269ee Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 21:04:41 +0000 Subject: The constant NAN causes a range check error on OS X. I've set LastDrawBeat to 0 - would this be OK for all Platforms? git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@763 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULyrics.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 0d709eef..165084a8 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -153,7 +153,12 @@ begin PQueueLine:=@QueueLine; UseLinearFilter := True; + {$IFDEF DARWIN} + // eddie: Getting range check error with NAN on OS X: + LastDrawBeat:=0; + {$ELSE} LastDrawBeat:=NAN; + {$ENDIF} end; Constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); @@ -197,7 +202,12 @@ begin PUpperline:=@UpperLine; PLowerLine:=@LowerLine; PQueueLine:=@QueueLine; + {$IFDEF DARWIN} + // eddie: Getting range check error with NAN on OS X: + LastDrawBeat:=0; + {$ELSE} LastDrawBeat:=NAN; + {$ENDIF} end; -- cgit v1.2.3 From 49d52afc94a97f808adc246247989244ef2071ff Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 21:05:38 +0000 Subject: Added the new GetxxxxPath functions for OS X. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@764 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformMacOSX.pas | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index 4e0c9061..ff369049 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -16,7 +16,9 @@ type private public Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - function GetGamePath: WideString; override; + function GetLogPath : WideString; override; + function GetGameSharedPath : WideString; override; + function GetGameUserPath : WideString; override; end; implementation @@ -26,7 +28,7 @@ uses SysUtils, baseunix; // Mac applications are packaged in directories. // We have to cut the last two directories // to get the application directory. -Function TPlatformMacOSX.GetGamePath : WideString; +Function GetBundlePath : WideString; var x, i : integer; @@ -41,6 +43,21 @@ begin end; end; +function TPlatformMacOSX.GetLogPath : WideString; +begin + Result := GetBundlePath; +end; + +function TPlatformMacOSX.GetGameSharedPath : WideString; +begin + Result := GetBundlePath; +end; + +function TPlatformMacOSX.GetGameUserPath : WideString; +begin + Result := GetBundlePath; +end; + Function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; var i : Integer; -- cgit v1.2.3 From 19986ca4e578add66672d6597862e51221ac3666 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 21:07:38 +0000 Subject: Changed BrowsePos from Cardinal to Integer, because of range check errors at runtime. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@765 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 31db883d..a4709b43 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -104,7 +104,7 @@ type TSongs = class( TThread ) {$ENDIF} private - BrowsePos : Cardinal; //Actual Pos in Song Array + BrowsePos : Integer; //Actual Pos in Song Array. eddie: Must be int, because it could be decremented to -1. fNotify , fWatch : longint; fParseSongDirectory : boolean; -- cgit v1.2.3 From 167a453b22fe86c327b0b3cd1948e1fb919c13bb Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 22:26:48 +0000 Subject: Added UTF8-Conversion for values read out of the txt file. This must be done only on OS X. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@768 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 274bf404..69beefe9 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -54,6 +54,7 @@ implementation uses TextGL, UIni, + UPlatform, UMain; //-------------------- @@ -131,6 +132,15 @@ begin //Check the Identifier (If Value is given) if (Length(Value) <> 0) then begin + + {$IFDEF DARWIN} + if ((Identifier = 'MP3') or (Identifier = 'COVER') or (Identifier = 'BACKGROUND') or (Identifier = 'VIDEO')) then + begin + // Filenames on OS X must be UTF8: + Value := Utf8Encode(Value); + end; + {$ENDIF} + //----------- //Required Attributes @@ -332,7 +342,7 @@ Result := False; //Open File and set File Pointer to the beginning AssignFile(SongFile, Song.Path + Song.FileName); - + // if assinged( SongFile ) then begin try -- cgit v1.2.3 From 48be9f5bdc2050578789af544d4575d0b4dffed2 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 22:27:55 +0000 Subject: Changed the GamePath. Now the GamePath is loaded from Platform.GetGameUserPath. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@769 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UIni.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index abbef723..e4f5e823 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -174,6 +174,7 @@ uses //UFiles, UMain, SDL, ULanguage, + UPlatform, USkins, URecord, UCommandLine; @@ -197,7 +198,7 @@ var end; begin - GamePath := ExtractFilePath(ParamStr(0)); + GamePath := Platform.GetGameUserPath; if (Params.ConfigFile <> '') then try -- cgit v1.2.3 From 31195a7ab6e264d325a589b1dd6673d6ba3d0e5a Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Wed, 9 Jan 2008 22:29:28 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@770 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatform.pas | 8 +++----- Game/Code/Classes/UPlatformMacOSX.pas | 2 +- 2 files changed, 4 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas index bdd6cf78..19a960e7 100644 --- a/Game/Code/Classes/UPlatform.pas +++ b/Game/Code/Classes/UPlatform.pas @@ -29,7 +29,7 @@ type ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCA23DF}'] Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; - + function GetLogPath : WideString; function GetGameSharedPath : WideString; function GetGameUserPath : WideString; @@ -40,8 +40,8 @@ type // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false // directories are completely ignored. - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; virtual; abstract; - + function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; virtual; abstract; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; virtual; // function GetGamePath : WideString; virtual; @@ -93,8 +93,6 @@ begin result := ExtractFilePath(ParamStr(0)); end; - - function TPlatform.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; begin // Linux and Mac don't check for running apps at the moment diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index ff369049..a418919c 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -15,7 +15,7 @@ type TPlatformMacOSX = class(TPlatform) private public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; function GetLogPath : WideString; override; function GetGameSharedPath : WideString; override; function GetGameUserPath : WideString; override; -- cgit v1.2.3 From d69c2a35192623e5d923f17c07d96d980d045adf Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 10 Jan 2008 22:59:10 +0000 Subject: partial seeking and mixing support git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@775 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 273 +++++++++++++++++++------ Game/Code/Classes/UAudioPlayback_Portaudio.pas | 123 ++++++----- 2 files changed, 275 insertions(+), 121 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas index 54055454..c81e4be1 100644 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -26,9 +26,11 @@ uses Classes, {$ENDIF} SysUtils, SDL, - avcodec, // FFMpeg Audio file decoding + avcodec, // FFMpeg Audio file decoding avformat, avutil, + avio, // used for url_ferror + mathematics, // used for av_rescale_q ULog, UMusic; @@ -64,10 +66,15 @@ type function Put(pkt : PAVPacket): integer; function Get(var pkt: TAVPacket; block: boolean): integer; + procedure Flush(); end; +const + MAX_AUDIOQ_SIZE = (5 * 16 * 1024); + var - EOSPacket: TAVPacket; + EOFPacket: TAVPacket; + FlushPacket: TAVPacket; type PAudioBuffer = ^TAudioBuffer; @@ -76,9 +83,17 @@ type type TFFMpegDecodeStream = class(TAudioDecodeStream) private - status: TStreamStatus; + _EOF: boolean; // end-of-stream flag + _EOF_lock : PSDL_Mutex; + + lock : PSDL_Mutex; + resumeCond : PSDL_Cond; + + quitRequest : boolean; - EOS_Flag: boolean; // end-of-stream flag + seekRequest: boolean; + seekFlags : integer; + seekPos : int64; parseThread: PSDL_Thread; packetQueue: TPacketQueue; @@ -87,8 +102,8 @@ type pFormatCtx : PAVFormatContext; pCodecCtx : PAVCodecContext; pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; + ffmpegStreamIndex : Integer; + ffmpegStream : PAVStream; // "static" vars for DecodeFrame pkt : TAVPacket; @@ -101,6 +116,7 @@ type audio_buf : TAudioBuffer; function DecodeFrame(var buffer: TAudioBuffer; bufSize: integer): integer; + procedure SetEOF(state: boolean); public constructor Create(pFormatCtx: PAVFormatContext; pCodecCtx: PAVCodecContext; pCodec: PAVCodec; @@ -114,7 +130,7 @@ type function GetSampleRate(): cardinal; override; function GetPosition: real; override; procedure SetPosition(Time: real); override; - function IsEOS(): boolean; override; + function IsEOF(): boolean; override; function ReadData(Buffer: PChar; BufSize: integer): integer; override; end; @@ -122,7 +138,7 @@ type type TAudioDecoder_FFMpeg = class( TInterfacedObject, IAudioDecoder ) private - class function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; + class function FindAudioStreamIndex(pFormatCtx : PAVFormatContext): integer; public function GetName: String; @@ -144,7 +160,6 @@ constructor TFFMpegDecodeStream.Create(pFormatCtx: PAVFormatContext; begin inherited Create(); - status := sStopped; packetQueue := TPacketQueue.Create(); audio_pkt_data := nil; @@ -158,30 +173,46 @@ begin Self.pFormatCtx := pFormatCtx; Self.pCodecCtx := pCodecCtx; Self.pCodec := pCodec; - Self.ffmpegStreamID := ffmpegStreamID; - Self.ffmpegStream := ffmpegStream; + Self.ffmpegStreamIndex := ffmpegStreamIndex; + Self.ffmpegStream := ffmpegStream; - EOS_Flag := false; + _EOF := false; + _EOF_lock := SDL_CreateMutex(); + + lock := SDL_CreateMutex(); + resumeCond := SDL_CreateCond(); parseThread := SDL_CreateThread(@ParseAudio, Self); end; destructor TFFMpegDecodeStream.Destroy(); begin - packetQueue.Free(); - //SDL_WaitThread(parseThread, nil); + //Close(); + //packetQueue.Free(); inherited; end; procedure TFFMpegDecodeStream.Close(); begin + // TODO: abort thread + //quitRequest := true; + //SDL_WaitThread(parseThread, nil); + + (* // Close the codec - avcodec_close(pCodecCtx); + if (pCodecCtx <> nil) then + begin + avcodec_close(pCodecCtx); + pCodecCtx := nil; + end; // Close the video file - av_close_input_file(pFormatCtx); - - // TODO: abort thread + if (pFormatCtx <> nil) then + begin + av_close_input_file(pFormatCtx); + pFormatCtx := nil; + end; + *) end; function TFFMpegDecodeStream.GetLength(): real; @@ -199,24 +230,134 @@ begin result := pCodecCtx^.sample_rate; end; -function TFFMpegDecodeStream.IsEOS(): boolean; +function TFFMpegDecodeStream.IsEOF(): boolean; +begin + SDL_mutexP(_EOF_lock); + result := _EOF; + SDL_mutexV(_EOF_lock); +end; + +procedure TFFMpegDecodeStream.SetEOF(state: boolean); +begin + SDL_mutexP(_EOF_lock); + _EOF := state; + SDL_mutexV(_EOF_lock); +end; + +function TFFMpegDecodeStream.GetPosition(): real; +var + bytes: integer; begin - result := EOS_Flag; + // see: tutorial on synching (audio-clock) + Result := 0; end; +procedure TFFMpegDecodeStream.SetPosition(Time: real); +var + bytes: integer; +begin + SDL_mutexP(lock); + seekPos := Trunc(Time * AV_TIME_BASE); + // FIXME: seek_flags = rel < 0 ? AVSEEK_FLAG_BACKWARD : 0 + seekFlags := 0; + seekRequest := true; + SDL_CondSignal(resumeCond); + SDL_mutexV(lock); +end; function ParseAudio(streamPtr: Pointer): integer; cdecl; var packet: TAVPacket; stream: TFFMpegDecodeStream; + seekTarget: int64; + eofState: boolean; begin stream := TFFMpegDecodeStream(streamPtr); + eofState := false; - while (av_read_frame(stream.pFormatCtx, packet) >= 0) do + while (true) do begin + + SDL_mutexP(stream.lock); + + // wait if end-of-file reached + if (eofState) then + begin + if (not (stream.seekRequest or stream.quitRequest)) then + begin + // signal end-of-file + stream.packetQueue.put(@EOFPacket); + // wait for reuse or destruction of stream + repeat + SDL_CondWait(stream.resumeCond, stream.lock); + until (stream.seekRequest or stream.quitRequest); + end; + eofState := false; + stream.SetEOF(false); + end; + + if (stream.quitRequest) then + begin + break; + end; + + // handle seek-request + if(stream.seekRequest) then + begin + // TODO: Do we need this? + // The position is converted to AV_TIME_BASE and then to the stream-specific base. + // Why not convert to the stream-specific one from the beginning. + seekTarget := av_rescale_q(stream.seekPos, AV_TIME_BASE_Q, stream.ffmpegStream^.time_base); + if(av_seek_frame(stream.pFormatCtx, stream.ffmpegStreamIndex, + seekTarget, stream.seekFlags) = 0) then + begin + Log.LogStatus(stream.pFormatCtx^.filename + ': error while seeking', 'UAudioDecoder_FFMpeg'); + end + else + begin + stream.packetQueue.Flush(); + stream.packetQueue.Put(@FlushPacket); + end; + stream.seekRequest := false; + end; + + SDL_mutexV(stream.lock); + + + if(stream.packetQueue.size > MAX_AUDIOQ_SIZE) then + begin + SDL_Delay(10); + continue; + end; + + if(av_read_frame(stream.pFormatCtx, packet) < 0) then + begin + // check for end-of-file (eof is not an error) + if(url_feof(@stream.pFormatCtx^.pb) <> 0) then + begin + eofState := true; + continue; + end; + + // check for errors + if(url_ferror(@stream.pFormatCtx^.pb) = 0) then + begin + // no error -> wait for user input + SDL_Delay(100); + continue; + end + else + begin + // an error occured -> abort + // TODO: eof or quit? + eofState := true; + continue; + end; + end; + //writeln( 'ffmpeg - av_read_frame' ); - if (packet.stream_index = stream.ffmpegStreamID) then + if(packet.stream_index = stream.ffmpegStreamIndex) then begin //writeln( 'packet_queue_put' ); stream.packetQueue.put(@packet); @@ -229,9 +370,6 @@ begin //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); - // signal end-of-stream - stream.packetQueue.put(@EOSPacket); - result := 0; end; @@ -242,10 +380,10 @@ var begin result := -1; - if (EOS_Flag) then + if EOF then exit; - while true do + while(true) do begin while (audio_pkt_size > 0) do begin @@ -253,6 +391,8 @@ begin data_size := bufSize; // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + // FIXME: with avcodec_decode_audio a package could contain several frames + // this is not handled yet len1 := avcodec_decode_audio(pCodecCtx, @buffer, data_size, audio_pkt_data, audio_pkt_size); @@ -294,11 +434,17 @@ begin audio_pkt_data := PChar(pkt.data); audio_pkt_size := pkt.size; - // check for end-of-stream - if (audio_pkt_data = PChar(EOSPacket.data)) then + if (audio_pkt_data = PChar(FlushPacket.data)) then + begin + avcodec_flush_buffers(pCodecCtx); + continue; + end; + + // check for end-of-file + if (audio_pkt_data = PChar(EOFPacket.data)) then begin - // end-of-stream reached -> set EOS-flag - EOS_Flag := true; + // end-of-file reached -> set EOF-flag + SetEOF(true); // note: buffer is not (even partially) filled -> no data to return exit; end; @@ -316,9 +462,10 @@ var len : integer; begin len := BufSize; + result := -1; - // end-of-stream reached - if (EOS_Flag) then + // end-of-file reached + if EOF then exit; while (len > 0) do begin @@ -361,19 +508,6 @@ begin result := BufSize; end; -function TFFMpegDecodeStream.GetPosition(): real; -var - bytes: integer; -begin - Result := 0; -end; - -procedure TFFMpegDecodeStream.SetPosition(Time: real); -var - bytes: integer; -begin -end; - { TAudioDecoder_FFMpeg } @@ -388,21 +522,25 @@ begin av_register_all(); - // init end-of-stream package - av_init_packet(EOSPacket); - EOSPacket.data := Pointer(PChar('EOS')); + // init end-of-file package + av_init_packet(EOFPacket); + EOFPacket.data := Pointer(PChar('EOF')); + + // init flush package + av_init_packet(FlushPacket); + FlushPacket.data := Pointer(PChar('FLUSH')); result := true; end; -class function TAudioDecoder_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; +class function TAudioDecoder_FFMpeg.FindAudioStreamIndex(pFormatCtx : PAVFormatContext): integer; var i : integer; - streamID: integer; + streamIndex: integer; stream : PAVStream; begin // Find the first audio stream - streamID := -1; + streamIndex := -1; for i := 0 to pFormatCtx^.nb_streams-1 do begin @@ -412,12 +550,12 @@ begin if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then begin //Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); - streamID := i; + streamIndex := i; break; end; end; - result := streamID; + result := streamIndex; end; function TAudioDecoder_FFMpeg.Open(const Filename: string): TAudioDecodeStream; @@ -449,11 +587,11 @@ begin dump_format(pFormatCtx, 0, pchar(Filename), 0); - ffmpegStreamID := FindAudioStreamID(pFormatCtx); + ffmpegStreamID := FindAudioStreamIndex(pFormatCtx); if (ffmpegStreamID < 0) then exit; - //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; pCodecCtx := ffmpegStream^.codec; @@ -503,7 +641,7 @@ var begin result := -1; - if (pkt <> @EOSPacket) then + if ((pkt <> @EOFPacket) and (pkt <> @FlushPacket)) then if (av_dup_packet(pkt) < 0) then exit; @@ -585,6 +723,27 @@ begin end; end; +procedure TPacketQueue.Flush(); +var + pkt, pkt1: PAVPacketList; +begin + SDL_LockMutex(Self.mutex); + + pkt := Self.firstPkt; + while(pkt <> nil) do + begin + pkt1 := pkt^.next; + av_free_packet(pkt^.pkt); + av_freep(pkt); + pkt := pkt1; + end; + Self.lastPkt := nil; + Self.firstPkt := nil; + Self.nbPackets := 0; + Self.size := 0; + + SDL_UnlockMutex(Self.mutex); +end; initialization diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index c2694e6d..c1abd0eb 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -22,6 +22,7 @@ uses libc, {$endif} {$ENDIF} + sdl, portaudio, ULog, UIni, @@ -58,6 +59,7 @@ type TAudioMixerStream = class private activeStreams: TList; + mixerBuffer: PChar; public constructor Create(); destructor Destroy(); override; @@ -104,7 +106,7 @@ type procedure Rewind; procedure SetPosition(Time: real); procedure Play; - procedure Pause; //Pause Mod + procedure Pause; procedure Stop; procedure Close; @@ -152,6 +154,8 @@ end; destructor TAudioMixerStream.Destroy(); begin + if (mixerBuffer <> nil) then + Freemem(mixerBuffer); activeStreams.Free; end; @@ -170,36 +174,33 @@ end; function TAudioMixerStream.ReadData(Buffer: PChar; BufSize: integer): integer; var i: integer; + size: integer; stream: TPortaudioPlaybackStream; - dataAvailable: boolean; begin - dataAvailable := false; + result := BufSize; - // search for playing stream - if (activeStreams.Count > 0) then + // zero target-buffer (silence) + FillChar(Buffer^, BufSize, 0); + + // resize mixer-buffer + ReallocMem(mixerBuffer, BufSize); + if (mixerBuffer = nil) then + Exit; + + writeln('Mix: ' + inttostr(activeStreams.Count)); + + for i := 0 to activeStreams.Count-1 do begin - for i := 0 to activeStreams.Count-1 do + stream := TPortaudioPlaybackStream(activeStreams[i]); + if (stream.GetStatus() = sPlaying) then begin - stream := TPortaudioPlaybackStream(activeStreams[i]); - if (stream.getStatus = sPlaying) then + // fetch data from current stream + size := stream.ReadData(mixerBuffer, BufSize); + if (size > 0) then begin - dataAvailable := true; - break; + SDL_MixAudio(PUInt8(Buffer), PUInt8(mixerBuffer), size, SDL_MIX_MAXVOLUME); end; end; - - // fetch data from current stream - if (dataAvailable) then - begin - result := stream.ReadData(Buffer, BufSize); - end; - end; - - // return silence - if ((not dataAvailable) or (result = -1)) then - begin - FillChar(Buffer^, BufSize, 0); - result := BufSize; end; end; @@ -219,7 +220,13 @@ end; procedure TPortaudioPlaybackStream.Play(); begin + if (status <> sPaused) then + begin + // rewind + decodeStream.Position := 0; + end; status := sPlaying; + mixerStream.AddStream(Self); end; procedure TPortaudioPlaybackStream.Pause(); @@ -234,7 +241,9 @@ end; procedure TPortaudioPlaybackStream.Close(); begin - Stop(); + status := sStopped; + Loaded := false; + // TODO: cleanup decode-stream end; function TPortaudioPlaybackStream.IsLoaded(): boolean; @@ -265,8 +274,8 @@ end; function TPortaudioPlaybackStream.ReadData(Buffer: PChar; BufSize: integer): integer; begin result := decodeStream.ReadData(Buffer, BufSize); - // end-of-stream reached -> stop playback - if (decodeStream.EOS) then + // end-of-file reached -> stop playback + if (decodeStream.EOF) then begin status := sStopped; end; @@ -424,7 +433,9 @@ end; procedure TAudioPlayback_Portaudio.SetLoop(Enabled: boolean); begin - MusicStream.SetLoop(Enabled); + if (MusicStream <> nil) then + if (MusicStream.IsLoaded) then + MusicStream.SetLoop(Enabled); end; function TAudioPlayback_Portaudio.Open(Filename: string): boolean; @@ -449,8 +460,6 @@ begin end; procedure TAudioPlayback_Portaudio.SetPosition(Time: real); -var - bytes: integer; begin if (MusicStream.IsLoaded) then begin @@ -458,10 +467,26 @@ begin end; end; +function TAudioPlayback_Portaudio.GetPosition: real; +begin + if (MusicStream.IsLoaded) then + Result := MusicStream.GetPosition(); +end; + +function TAudioPlayback_Portaudio.Length: real; +begin + Result := 0; + if assigned( MusicStream ) then + if (MusicStream.IsLoaded) then + begin + Result := MusicStream.GetLength(); + end; +end; + procedure TAudioPlayback_Portaudio.Play; begin if (MusicStream <> nil) then - if (MusicStream.IsLoaded()) then + if (MusicStream.IsLoaded) then begin if (MusicStream.GetLoop()) then begin @@ -472,12 +497,10 @@ begin end; end; -procedure TAudioPlayback_Portaudio.Pause; //Pause Mod +procedure TAudioPlayback_Portaudio.Pause; begin if (MusicStream <> nil) then - if (MusicStream.IsLoaded()) then begin - MusicStream.Pause(); // Pauses Song - end; + MusicStream.Pause(); end; procedure TAudioPlayback_Portaudio.Stop; @@ -492,37 +515,10 @@ begin MusicStream.Close(); end; -function TAudioPlayback_Portaudio.Length: real; -begin - Result := 0; - if assigned( MusicStream ) then - begin - Result := MusicStream.GetLength(); - end; -end; - -function TAudioPlayback_Portaudio.getPosition: real; -var - bytes: integer; -begin - Result := 0; - -(* - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -*) -end; - function TAudioPlayback_Portaudio.Finished: boolean; begin - Result := false; - -(* - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -*) + if MusicStream <> nil then + Result := (MusicStream.GetStatus() = sStopped); end; procedure TAudioPlayback_Portaudio.PlayStart; @@ -623,7 +619,6 @@ begin end; playbackStream := TPortaudioPlaybackStream.Create(decodeStream); - mixerStream.AddStream(playbackStream); //Add CustomSound csIndex := High(CustomSounds) + 1; -- cgit v1.2.3 From c1a89635c888f21203db62021cb30333d5d80a47 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 03:27:40 +0000 Subject: some minor changes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@780 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 10 ++++++++-- Game/Code/Classes/UAudioPlayback_Portaudio.pas | 6 +++++- 2 files changed, 13 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas index c81e4be1..7ea9dd6a 100644 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -271,6 +271,7 @@ var stream: TFFMpegDecodeStream; seekTarget: int64; eofState: boolean; + pbIOCtx: PByteIOContext; begin stream := TFFMpegDecodeStream(streamPtr); eofState := false; @@ -333,14 +334,19 @@ begin if(av_read_frame(stream.pFormatCtx, packet) < 0) then begin // check for end-of-file (eof is not an error) - if(url_feof(@stream.pFormatCtx^.pb) <> 0) then + {$IF (LIBAVFORMAT_VERSION >= 52)} + pbIOCtx := stream.pFormatCtx^.pb; + {$ELSE} + pbIOCtx := @stream.pFormatCtx^.pb; + {$IFEND} + if(url_feof(pbIOCtx) <> 0) then begin eofState := true; continue; end; // check for errors - if(url_ferror(@stream.pFormatCtx^.pb) = 0) then + if(url_ferror(pbIOCtx) = 0) then begin // no error -> wait for user input SDL_Delay(100); diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index c1abd0eb..5f4a8cde 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -226,7 +226,7 @@ begin decodeStream.Position := 0; end; status := sPlaying; - mixerStream.AddStream(Self); + //mixerStream.AddStream(Self); end; procedure TPortaudioPlaybackStream.Pause(); @@ -444,6 +444,8 @@ var begin decodeStream := AudioDecoder.Open(Filename); MusicStream := TPortaudioPlaybackStream.Create(decodeStream); + // FIXME: remove this line + mixerStream.AddStream(MusicStream); if(MusicStream.IsLoaded()) then begin @@ -619,6 +621,8 @@ begin end; playbackStream := TPortaudioPlaybackStream.Create(decodeStream); + // FIXME: remove this line + mixerStream.AddStream(playbackStream); //Add CustomSound csIndex := High(CustomSounds) + 1; -- cgit v1.2.3 From 34d10d2e193b83e5ae7cff9037708fd44d801e60 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 03:33:10 +0000 Subject: do not initialize sdl_audio at this place git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@781 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UGraphic.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 3536d9d7..fcda137c 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -415,7 +415,7 @@ begin LoadOpenGL; Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); - if ( SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO)= -1 ) then + if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then begin Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); exit; -- cgit v1.2.3 From 69af8d0951d9c741680e9c7f5c5ccd63f36b8df5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 11:50:24 +0000 Subject: FPC compatible FFMPEG versioning support. Version-numbers are in the form AAIISS now instead of AA.IISS (which is not supported by fpc) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@783 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 2 +- Game/Code/Classes/UAudio_FFMpeg_Pa.pas | 980 ----------------------------- 2 files changed, 1 insertion(+), 981 deletions(-) delete mode 100644 Game/Code/Classes/UAudio_FFMpeg_Pa.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas index 7ea9dd6a..4cd6ec37 100644 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -334,7 +334,7 @@ begin if(av_read_frame(stream.pFormatCtx, packet) < 0) then begin // check for end-of-file (eof is not an error) - {$IF (LIBAVFORMAT_VERSION >= 52)} + {$IF (LIBAVFORMAT_MAJOR_VERSION >= 52)} pbIOCtx := stream.pFormatCtx^.pb; {$ELSE} pbIOCtx := @stream.pFormatCtx^.pb; diff --git a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas b/Game/Code/Classes/UAudio_FFMpeg_Pa.pas deleted file mode 100644 index 400af7ce..00000000 --- a/Game/Code/Classes/UAudio_FFMpeg_Pa.pas +++ /dev/null @@ -1,980 +0,0 @@ -unit UAudio_FFMpeg_Pa; - -(******************************************************************************* - -This unit is primarily based upon - - http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - - and tutorial03.c - - http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - SDL, // Used for Audio output Interface - avcodec, // FFMpeg Audio file decoding - avformat, - avutil, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ifndef win32} - libc, // not available in win32 - {$endif} - {$ENDIF} - portaudio, - UIni, - UMain, - UThemes; - - -type - PPacketQueue = ^TPacketQueue; - TPacketQueue = class - private - firstPkt, - lastPkt : PAVPacketList; - nbPackets : integer; - size : integer; - mutex : PSDL_Mutex; - cond : PSDL_Cond; - quit : boolean; - - public - constructor Create(); - - function Put(pkt : PAVPacket): integer; - function Get(var pkt: TAVPacket; block: boolean): integer; - end; - -type - TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); - -const - StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); - -type - PAudioBuffer = ^TAudioBuffer; - TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; - -const - SDL_AUDIO_BUFFER_SIZE = 1024; - -type - TFFMpegOutputStream = class(TAudioOutputStream) - private - parseThread: PSDL_Thread; - packetQueue: TPacketQueue; - - status: TStreamStatus; - - // FFMpeg internal data - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - - // static vars for AudioDecodeFrame - pkt : TAVPacket; - audio_pkt_data : PChar; - audio_pkt_size : integer; - - // static vars for AudioCallback - audio_buf_index : cardinal; - audio_buf_size : cardinal; - audio_buf : TAudioBuffer; - - channel: PPaStream; - public - constructor Create(); overload; - constructor Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; - - procedure Play(); - procedure Pause(); - procedure Stop(); - procedure Close(); - - function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; - end; - -type - TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) - private - MusicStream: TFFMpegOutputStream; - - StartSoundStream: TFFMpegOutputStream; - BackSoundStream: TFFMpegOutputStream; - SwooshSoundStream: TFFMpegOutputStream; - ChangeSoundStream: TFFMpegOutputStream; - OptionSoundStream: TFFMpegOutputStream; - ClickSoundStream: TFFMpegOutputStream; - DrumSoundStream: TFFMpegOutputStream; - HihatSoundStream: TFFMpegOutputStream; - ClapSoundStream: TFFMpegOutputStream; - ShuffleSoundStream: TFFMpegOutputStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; - public - function GetName: String; - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(Name: string): TFFMpegOutputStream; - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - end; - -var - test: TFFMpegOutputStream; - it: integer; - -var - singleton_MusicFFMpeg : IAudioPlayback = nil; - - -function ParseAudio(data: Pointer): integer; cdecl; forward; -procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; forward; - -constructor TFFMpegOutputStream.Create(); -begin - inherited; - - packetQueue := TPacketQueue.Create(); - - FillChar(pkt, sizeof(TAVPacket), #0); - - status := sStopped; - - audio_pkt_data := nil; - audio_pkt_size := 0; - - audio_buf_index := 0; - audio_buf_size := 0; -end; - -constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); -begin - Create(); - - Self.pFormatCtx := pFormatCtx; - Self.pCodecCtx := pCodecCtx; - Self.pCodec := pCodec; - Self.ffmpegStreamID := ffmpegStreamID; - Self.ffmpegStream := ffmpegStream; - - test := Self; - it:=0; -end; - -procedure TFFMpegOutputStream.Play(); -var - err: TPaError; -begin - writeln('Play request'); - if(status = sStopped) then - begin - writeln('Play ok'); - status := sPlaying; - Self.parseThread := SDL_CreateThread(@ParseAudio, Self); - //SDL_PauseAudio(0); - - err := Pa_StartStream(Self.channel); - end; -end; - -procedure TFFMpegOutputStream.Pause(); -begin -end; - -procedure TFFMpegOutputStream.Stop(); -begin -end; - -procedure TFFMpegOutputStream.Close(); -begin - // Close the codec - avcodec_close(pCodecCtx); - - // Close the video file - av_close_input_file(pFormatCtx); -end; - - -function TAudio_FFMpeg.GetName: String; -begin - result := 'FFMpeg'; -end; - -procedure TAudio_FFMpeg.InitializePlayback; -begin - Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); - - Loaded := false; - Loop := false; - - av_register_all(); - //SDL_Init(SDL_INIT_AUDIO); - Pa_Initialize(); - - StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); - { - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common Back.mp3'); - SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); - ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); - OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); - ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); - } -// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); -// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); -// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); - -// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); -end; - - -procedure TAudio_FFMpeg.SetVolume(Volume: integer); -begin - //New: Sets Volume only for this Application -(* - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -*) -end; - -procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume -// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_FFMpeg.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin -// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_FFMpeg.Rewind; -begin - if Loaded then - begin - end; -end; - -procedure TAudio_FFMpeg.MoveTo(Time: real); -var - bytes: integer; -begin -// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); -// BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TAudio_FFMpeg.Play; -begin - if MusicStream <> nil then - if Loaded then - begin - if Loop then - begin - end; - // start from beginning... - // actually bass itself does not loop, nor does this TAudio_FFMpeg Class - MusicStream.Play(); - end; -end; - -procedure TAudio_FFMpeg.Pause; //Pause Mod -begin - if MusicStream <> nil then - if Loaded then begin - MusicStream.Pause(); // Pauses Song - end; -end; - -procedure TAudio_FFMpeg.Stop; -begin - if MusicStream <> nil then - MusicStream.Stop(); -end; - -procedure TAudio_FFMpeg.Close; -begin - if MusicStream <> nil then - MusicStream.Close(); -end; - -function TAudio_FFMpeg.Length: real; -var - bytes: integer; -begin - Result := 0; - // Todo : why is Music stream always nil !? - - if assigned( MusicStream ) then - begin - Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; - end; -end; - -function TAudio_FFMpeg.getPosition: real; -var - bytes: integer; -begin - Result := 0; - -(* - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -*) -end; - -function TAudio_FFMpeg.Finished: boolean; -begin - Result := false; - -(* - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -*) -end; - -procedure TAudio_FFMpeg.PlayStart; -begin - if StartSoundStream <> nil then - StartSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayBack; -begin - if BackSoundStream <> nil then - BackSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlaySwoosh; -begin - if SwooshSoundStream <> nil then - SwooshSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayChange; -begin - if ChangeSoundStream <> nil then - ChangeSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayOption; -begin - if OptionSoundStream <> nil then - OptionSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClick; -begin - if ClickSoundStream <> nil then - ClickSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayDrum; -begin - if DrumSoundStream <> nil then - DrumSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayHihat; -begin - if HihatSoundStream <> nil then - HihatSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClap; -begin - if ClapSoundStream <> nil then - ClapSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.StopShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Stop(); -end; - - -function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; -var - len1, - data_size: integer; -begin - result := -1; - - if (buffer = nil) then - exit; - - while true do - begin - while (audio_pkt_size > 0) do - begin -// writeln( 'got audio packet' ); - data_size := bufSize; - - if(pCodecCtx = nil) then begin -// writeln('Das wars'); - exit; - end; - - // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. - len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), - data_size, audio_pkt_data, audio_pkt_size); - - //writeln('avcodec_decode_audio : ' + inttostr( len1 )); - - if(len1 < 0) then - begin - // if error, skip frame -// writeln( 'Skip audio frame' ); - audio_pkt_size := 0; - break; - end; - - audio_pkt_data := audio_pkt_data + len1; - audio_pkt_size := audio_pkt_size + len1; - - if (data_size <= 0) then - begin - // No data yet, get more frames - continue; - end; - - // We have data, return it and come back for more later - result := data_size; - exit; - end; - - inc(it); - if (pkt.data <> nil) then - begin - av_free_packet(pkt); - end; - - if (packetQueue.quit) then - begin - result := -1; - exit; - end; -// writeln(it); - if (packetQueue.Get(pkt, true) < 0) then - begin - result := -1; - exit; - end; - - audio_pkt_data := PChar(pkt.data); - audio_pkt_size := pkt.size; -// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; -end; - -procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; -begin - outStream := TFFMpegOutputStream(userdata); - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; // Todo : jb - SegFault ? - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(stream, pSrc , len1); - {$else} - memcpy(stream, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(stream, len1); - Inc(audio_buf_index, len1); - end; -end; - -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; - len : integer; -begin - outStream := TFFMpegOutputStream(userData); - len := frameCount * 2; // use *2 for mono-files - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; // Todo : jb - SegFault ? - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(output, pSrc , len1); - {$else} - memcpy(output, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(PChar(output), len1); - Inc(audio_buf_index, len1); - end; - - result := paContinue; -end; - -function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; -var - i : integer; - streamID: integer; - stream : PAVStream; -begin - // Find the first audio stream - streamID := -1; - - for i := 0 to pFormatCtx^.nb_streams-1 do - begin - //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); - stream := pFormatCtx^.streams[i]; - - if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then - begin - Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); - streamID := i; - break; - end; - end; - - result := streamID; -end; - -function ParseAudio(data: Pointer): integer; cdecl; -var - packet: TAVPacket; - stream: TFFMpegOutputStream; -begin - stream := TFFMpegOutputStream(data); - - while (av_read_frame(stream.pFormatCtx, packet) >= 0) do - begin - //writeln( 'ffmpeg - av_read_frame' ); - - if (packet.stream_index = stream.ffmpegStreamID) then - begin - //writeln( 'packet_queue_put' ); - stream.packetQueue.put(@packet); - end - else - begin - av_free_packet(packet); - end; - end; - - //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); - - result := 0; -end; - - -function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; -var - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - wanted_spec, - spec : TSDL_AudioSpec; - csIndex : integer; - stream : TFFMpegOutputStream; - err : TPaError; -begin - result := nil; - - if (not FileExists(Name)) then - begin - Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); - writeln('ERROR : LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); - exit; - end; - - // Open audio file - if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then - exit; - - // Retrieve stream information - if (av_find_stream_info(pFormatCtx) < 0) then - exit; - - dump_format(pFormatCtx, 0, pchar(Name), 0); - - ffmpegStreamID := FindAudioStreamID(pFormatCtx); - if (ffmpegStreamID < 0) then - exit; - - //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); - - ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; - pCodecCtx := ffmpegStream^.codec; - - pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); - if (pCodec = nil) then - begin - Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); - exit; - end; - - avcodec_open(pCodecCtx, pCodec); - //writeln( 'Opened the codec' ); - - stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, - ffmpegStreamID, ffmpegStream); - - { - // Set SDL audio settings from codec info - wanted_spec.freq := pCodecCtx^.sample_rate; - wanted_spec.format := AUDIO_S16SYS; - wanted_spec.channels := pCodecCtx^.channels; - wanted_spec.silence := 0; - wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; - wanted_spec.callback := AudioCallback; - wanted_spec.userdata := stream; - - // TODO: this works only one time (?) - if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then - begin - Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - } - - err := Pa_OpenDefaultStream(stream.channel, 0, pCodecCtx^.channels, paInt16, - pCodecCtx^.sample_rate, SDL_AUDIO_BUFFER_SIZE div 2, //paFramesPerBufferUnspecified, - @PA_AudioCallback, stream); - if(err <> paNoError) then begin - Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - - Log.LogStatus('SDL opened audio device', 'UAudio_FFMpeg'); - - //Add CustomSound - csIndex := High(CustomSounds) + 1; - SetLength (CustomSounds, csIndex + 1); - CustomSounds[csIndex].Filename := Name; - CustomSounds[csIndex].Stream := stream; - - result := stream; -end; - -//Equalizer -function TAudio_FFMpeg.GetFFTData: TFFTData; -var - data: TFFTData; -begin - //Get Channel Data Mono and 256 Values -// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - result := data; -end; - -// Interface for Visualizer -function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; -begin - result := 0; -end; - -function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; -var - S: TFFMpegOutputStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - S := LoadSoundFromFile(SoundPath + Filename); - if (S <> nil) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); -end; - - -constructor TPacketQueue.Create(); -begin - inherited; - - firstPkt := nil; - lastPkt := nil; - nbPackets := 0; - size := 0; - - mutex := SDL_CreateMutex(); - cond := SDL_CreateCond(); -end; - -function TPacketQueue.Put(pkt : PAVPacket): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - if (av_dup_packet(pkt) < 0) then - exit; - - pkt1 := av_malloc(sizeof(TAVPacketList)); - if (pkt1 = nil) then - exit; - - pkt1^.pkt := pkt^; - pkt1^.next := nil; - - - SDL_LockMutex(Self.mutex); - try - - if (Self.lastPkt = nil) then - Self.firstPkt := pkt1 - else - Self.lastPkt^.next := pkt1; - - Self.lastPkt := pkt1; - inc(Self.nbPackets); - -// Writeln('Put: ' + inttostr(nbPackets)); - - Self.size := Self.size + pkt1^.pkt.size; - SDL_CondSignal(Self.cond); - - finally - SDL_UnlockMutex(Self.mutex); - end; - - result := 0; -end; - -function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - SDL_LockMutex(Self.mutex); - try - while true do - begin - if (quit) then - exit; - - pkt1 := Self.firstPkt; - - if (pkt1 <> nil) then - begin - Self.firstPkt := pkt1.next; - if (Self.firstPkt = nil) then - Self.lastPkt := nil; - dec(Self.nbPackets); - -// Writeln('Get: ' + inttostr(nbPackets)); - - Self.size := Self.size - pkt1^.pkt.size; - pkt := pkt1^.pkt; - av_free(pkt1); - - result := 1; - break; - end - else - if (not block) then - begin - result := 0; - break; - end - else - begin - SDL_CondWait(Self.cond, Self.mutex); - end; - end; - finally - SDL_UnlockMutex(Self.mutex); - end; -end; - - - -initialization - singleton_MusicFFMpeg := TAudio_FFMpeg.create(); - - writeln( 'UAudio_FFMpeg - Register Playback' ); - AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); - -finalization - AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); - - -end. -- cgit v1.2.3 From 4e4e55b6e62a225d7f70a8aa9342e91881decbc8 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 13:42:57 +0000 Subject: Updated to the new audio-interface git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@785 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioPlayback_Bass.pas | 86 +++++++++++++++++++++++++------ 1 file changed, 70 insertions(+), 16 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioPlayback_Bass.pas b/Game/Code/Classes/UAudioPlayback_Bass.pas index ee6b1ef9..87ff183d 100644 --- a/Game/Code/Classes/UAudioPlayback_Bass.pas +++ b/Game/Code/Classes/UAudioPlayback_Bass.pas @@ -31,18 +31,21 @@ uses UThemes; type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -type - TBassOutputStream = class(TAudioOutputStream) - Handle: HSTREAM; - - constructor Create(); overload; - constructor Create(stream: HSTREAM); overload; + TBassOutputStream = class(TAudioPlaybackStream) + private + Handle: HSTREAM; + public + constructor Create(); overload; + constructor Create(stream: HSTREAM); overload; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure Close(); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; end; type @@ -128,6 +131,61 @@ begin Handle := stream; end; +procedure TBassOutputStream.Play(); +begin + BASS_ChannelPlay(Handle, True); +end; + +procedure TBassOutputStream.Pause(); +begin + //if (Loaded) then + BASS_ChannelPause(Handle); +end; + +procedure TBassOutputStream.Stop(); +begin + BASS_ChannelStop(Handle); +end; + +procedure TBassOutputStream.Close(); +begin + Bass_StreamFree(Handle); +end; + +function TBassOutputStream.GetLoop(): boolean; +begin + // TODO + result := false; +end; + +procedure TBassOutputStream.SetLoop(Enabled: boolean); +begin + // TODO +end; + +function TBassOutputStream.GetLength(): real; +var + bytes: integer; +begin + bytes := BASS_ChannelGetLength(Handle); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +function TBassOutputStream.GetStatus(): TStreamStatus; +var + state: DWORD; +begin + state := BASS_ChannelIsActive(Handle); + case state of + BASS_ACTIVE_PLAYING: + result := sPlaying; + BASS_ACTIVE_PAUSED: + result := sPaused; + else + result := sStopped; + end; +end; + function TAudioPlayback_Bass.GetName: String; begin @@ -267,8 +325,6 @@ function TAudioPlayback_Bass.Length: real; var bytes: integer; begin - Result := 60; - bytes := BASS_ChannelGetLength(MusicStream); Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); end; @@ -277,8 +333,6 @@ function TAudioPlayback_Bass.getPosition: real; var bytes: integer; begin - Result := 0; - bytes := BASS_ChannelGetPosition(MusicStream); Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); end; -- cgit v1.2.3 From ff1dc556936cef441e105a19aa9d1d3b9e0cc833 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 13:52:44 +0000 Subject: changed from ffmpeg-free (audio) to ffmpeg-enabled (if turned on in switches.inc) version. BASS is used by default. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@786 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudio_FFMpeg.pas | 1005 -------------------------------- Game/Code/Classes/UAudio_bass.pas | 703 ---------------------- Game/Code/Classes/UAudio_portaudio.pas | 427 -------------- Game/Code/Classes/UMedia_dummy.pas | 13 +- Game/Code/Classes/UMusic.pas | 112 +++- Game/Code/Classes/UVideo.pas | 12 +- Game/Code/Classes/UVisualizer.pas | 15 +- 7 files changed, 117 insertions(+), 2170 deletions(-) delete mode 100644 Game/Code/Classes/UAudio_FFMpeg.pas delete mode 100644 Game/Code/Classes/UAudio_bass.pas delete mode 100644 Game/Code/Classes/UAudio_portaudio.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas deleted file mode 100644 index fb25b0f9..00000000 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ /dev/null @@ -1,1005 +0,0 @@ -unit UAudio_FFMpeg; - -(******************************************************************************* - -This unit is primarily based upon - - http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - - and tutorial03.c - - http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - SDL, // Used for Audio output Interface - avcodec, // FFMpeg Audio file decoding - avformat, - avutil, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ifndef win32} - libc, // not available in win32 - {$endif} - {$ENDIF} - portaudio, - UIni, - UMain, - UThemes; - - -type - PPacketQueue = ^TPacketQueue; - TPacketQueue = class - private - firstPkt, - lastPkt : PAVPacketList; - nbPackets : integer; - size : integer; - mutex : PSDL_Mutex; - cond : PSDL_Cond; - quit : boolean; - - public - constructor Create(); - - function Put(pkt : PAVPacket): integer; - function Get(var pkt: TAVPacket; block: boolean): integer; - end; - -type - TStreamStatus = (sNotReady, sStopped, sPlaying, sSeeking, sPaused, sOpen); - -const - StreamStatusStr: array[TStreamStatus] of string = ('Not ready', 'Stopped', 'Playing', 'Seeking', 'Paused', 'Open'); - -type - PAudioBuffer = ^TAudioBuffer; - TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; - -const - SDL_AUDIO_BUFFER_SIZE = 1024; - -type - TFFMpegOutputStream = class(TAudioOutputStream) - private - parseThread: PSDL_Thread; - packetQueue: TPacketQueue; - - status: TStreamStatus; - - // FFMpeg internal data - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - - // static vars for AudioDecodeFrame - pkt : TAVPacket; - audio_pkt_data : PChar; - audio_pkt_size : integer; - - // static vars for AudioCallback - audio_buf_index : cardinal; - audio_buf_size : cardinal; - audio_buf : TAudioBuffer; - - paStream : PPaStream; - paFrameSize : integer; - public - constructor Create(); overload; - constructor Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); overload; - - procedure Play(); - procedure Pause(); - procedure Stop(); - procedure Close(); - - function AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; - end; - -type - TAudio_FFMpeg = class( TInterfacedObject, IAudioPlayback ) - private - MusicStream: TFFMpegOutputStream; - - StartSoundStream: TFFMpegOutputStream; - BackSoundStream: TFFMpegOutputStream; - SwooshSoundStream: TFFMpegOutputStream; - ChangeSoundStream: TFFMpegOutputStream; - OptionSoundStream: TFFMpegOutputStream; - ClickSoundStream: TFFMpegOutputStream; - DrumSoundStream: TFFMpegOutputStream; - HihatSoundStream: TFFMpegOutputStream; - ClapSoundStream: TFFMpegOutputStream; - ShuffleSoundStream: TFFMpegOutputStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - function FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; - public - function GetName: String; - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(Name: string): TFFMpegOutputStream; - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - end; - -var - test: TFFMpegOutputStream; - it: integer; - -var - singleton_MusicFFMpeg : IAudioPlayback = nil; - - -function ParseAudio(data: Pointer): integer; cdecl; forward; -procedure SDL_AudioCallback( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; forward; -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; forward; - -constructor TFFMpegOutputStream.Create(); -begin - inherited; - - packetQueue := TPacketQueue.Create(); - - FillChar(pkt, sizeof(TAVPacket), #0); - - status := sStopped; - - audio_pkt_data := nil; - audio_pkt_size := 0; - - audio_buf_index := 0; - audio_buf_size := 0; -end; - -constructor TFFMpegOutputStream.Create(pFormatCtx: PAVFormatContext; - pCodecCtx: PAVCodecContext; pCodec: PAVCodec; - ffmpegStreamID : Integer; ffmpegStream: PAVStream); -begin - Create(); - - Self.pFormatCtx := pFormatCtx; - Self.pCodecCtx := pCodecCtx; - Self.pCodec := pCodec; - Self.ffmpegStreamID := ffmpegStreamID; - Self.ffmpegStream := ffmpegStream; - - test := Self; - it:=0; -end; - -procedure TFFMpegOutputStream.Play(); -var - err: TPaError; -begin - writeln('Play request'); - if(status = sStopped) then - begin - writeln('Play ok'); - status := sPlaying; - Self.parseThread := SDL_CreateThread(@ParseAudio, Self); - //SDL_PauseAudio(0); - - err := Pa_StartStream(Self.paStream); - if(err <> paNoError) then - begin - Writeln('Play: '+ Pa_GetErrorText(err)); - end; - end; -end; - -procedure TFFMpegOutputStream.Pause(); -begin -end; - -procedure TFFMpegOutputStream.Stop(); -begin -end; - -procedure TFFMpegOutputStream.Close(); -begin - // Close the codec - avcodec_close(pCodecCtx); - - // Close the video file - av_close_input_file(pFormatCtx); -end; - - -function TAudio_FFMpeg.GetName: String; -begin - result := 'FFMpeg'; -end; - -procedure TAudio_FFMpeg.InitializePlayback; -begin - Log.LogStatus('InitializePlayback', 'UAudio_FFMpeg'); - - Loaded := false; - Loop := false; - - av_register_all(); - //SDL_Init(SDL_INIT_AUDIO); - Pa_Initialize(); - - StartSoundStream := LoadSoundFromFile(SoundPath + 'Common start.mp3'); - BackSoundStream := LoadSoundFromFile(SoundPath + 'Common back.mp3'); - SwooshSoundStream := LoadSoundFromFile(SoundPath + 'menu swoosh.mp3'); - ChangeSoundStream := LoadSoundFromFile(SoundPath + 'select music change music 50.mp3'); - OptionSoundStream := LoadSoundFromFile(SoundPath + 'option change col.mp3'); - ClickSoundStream := LoadSoundFromFile(SoundPath + 'rimshot022b.mp3'); - -// DrumSoundStream := LoadSoundFromFile(SoundPath + 'bassdrumhard076b.mp3'); -// HihatSoundStream := LoadSoundFromFile(SoundPath + 'hihatclosed068b.mp3'); -// ClapSoundStream := LoadSoundFromFile(SoundPath + 'claps050b.mp3'); - -// ShuffleSoundStream := LoadSoundFromFile(SoundPath + 'Shuffle.mp3'); -end; - - -procedure TAudio_FFMpeg.SetVolume(Volume: integer); -begin - //New: Sets Volume only for this Application -(* - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -*) -end; - -procedure TAudio_FFMpeg.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - - //Set Volume -// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); -end; - -procedure TAudio_FFMpeg.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_FFMpeg.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin -// Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_FFMpeg.Rewind; -begin - if Loaded then - begin - end; -end; - -procedure TAudio_FFMpeg.MoveTo(Time: real); -var - bytes: integer; -begin -// bytes := BASS_ChannelSeconds2Bytes(Bass, Time); -// BASS_ChannelSetPosition(Bass, bytes); -end; - -procedure TAudio_FFMpeg.Play; -begin - if MusicStream <> nil then - if Loaded then - begin - if Loop then - begin - end; - // start from beginning... - // actually bass itself does not loop, nor does this TAudio_FFMpeg Class - MusicStream.Play(); - end; -end; - -procedure TAudio_FFMpeg.Pause; //Pause Mod -begin - if MusicStream <> nil then - if Loaded then begin - MusicStream.Pause(); // Pauses Song - end; -end; - -procedure TAudio_FFMpeg.Stop; -begin - if MusicStream <> nil then - MusicStream.Stop(); -end; - -procedure TAudio_FFMpeg.Close; -begin - if MusicStream <> nil then - MusicStream.Close(); -end; - -function TAudio_FFMpeg.Length: real; -var - bytes: integer; -begin - Result := 0; - // Todo : why is Music stream always nil !? - - if assigned( MusicStream ) then - begin - Result := MusicStream.pFormatCtx^.duration / AV_TIME_BASE; - end; -end; - -function TAudio_FFMpeg.getPosition: real; -var - bytes: integer; -begin - Result := 0; - -(* - bytes := BASS_ChannelGetPosition(BASS); - Result := BASS_ChannelBytes2Seconds(BASS, bytes); -*) -end; - -function TAudio_FFMpeg.Finished: boolean; -begin - Result := false; - -(* - if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -*) -end; - -procedure TAudio_FFMpeg.PlayStart; -begin - if StartSoundStream <> nil then - StartSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayBack; -begin - if BackSoundStream <> nil then - BackSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlaySwoosh; -begin - if SwooshSoundStream <> nil then - SwooshSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayChange; -begin - if ChangeSoundStream <> nil then - ChangeSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayOption; -begin - if OptionSoundStream <> nil then - OptionSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClick; -begin - if ClickSoundStream <> nil then - ClickSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayDrum; -begin - if DrumSoundStream <> nil then - DrumSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayHihat; -begin - if HihatSoundStream <> nil then - HihatSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayClap; -begin - if ClapSoundStream <> nil then - ClapSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.PlayShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Play(); -end; - -procedure TAudio_FFMpeg.StopShuffle; -begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Stop(); -end; - - -function TFFMpegOutputStream.AudioDecodeFrame(buffer : PUInt8; bufSize: integer): integer; -var - len1, - data_size: integer; -begin - result := -1; - - if (buffer = nil) then - exit; - - while true do - begin - while (audio_pkt_size > 0) do - begin -// writeln( 'got audio packet' ); - data_size := bufSize; - - if(pCodecCtx = nil) then begin -// writeln('Das wars'); - exit; - end; - - // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. - len1 := avcodec_decode_audio(pCodecCtx, Pointer(buffer), - data_size, audio_pkt_data, audio_pkt_size); - - //writeln('avcodec_decode_audio : ' + inttostr( len1 )); - - if(len1 < 0) then - begin - // if error, skip frame -// writeln( 'Skip audio frame' ); - audio_pkt_size := 0; - break; - end; - - Inc(audio_pkt_data, len1); - Dec(audio_pkt_size, len1); - - if (data_size <= 0) then - begin - // No data yet, get more frames - continue; - end; - - // We have data, return it and come back for more later - result := data_size; - exit; - end; - - inc(it); - if (pkt.data <> nil) then - begin - av_free_packet(pkt); - end; - - if (packetQueue.quit) then - begin - result := -1; - exit; - end; -// writeln(it); - if (packetQueue.Get(pkt, true) < 0) then - begin - result := -1; - exit; - end; - - audio_pkt_data := PChar(pkt.data); - audio_pkt_size := pkt.size; -// writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; -end; - -procedure SDL_AudioCallback(userdata: Pointer; stream: PUInt8; len: Integer); cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; -begin - outStream := TFFMpegOutputStream(userdata); - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(stream, pSrc , len1); - {$else} - memcpy(stream, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(stream, len1); - Inc(audio_buf_index, len1); - end; -end; - -function Pa_AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; -var - outStream : TFFMpegOutputStream; - len1, - audio_size : integer; - pSrc : Pointer; - len : integer; -begin - outStream := TFFMpegOutputStream(userData); - len := frameCount * outStream.paFrameSize; - - while (len > 0) do - with outStream do begin - if (audio_buf_index >= audio_buf_size) then - begin - // We have already sent all our data; get more - audio_size := AudioDecodeFrame(@audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); - - if(audio_size < 0) then - begin - // If error, output silence - audio_buf_size := 1024; - FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); - end - else - begin - audio_buf_size := audio_size; - end; - audio_buf_index := 0; // Todo : jb - SegFault ? - end; - - len1 := audio_buf_size - audio_buf_index; - if (len1 > len) then - len1 := len; - - pSrc := PChar(@audio_buf) + audio_buf_index; - {$ifdef WIN32} - CopyMemory(output, pSrc , len1); - {$else} - memcpy(output, pSrc , len1); - {$endif} - - Dec(len, len1); - Inc(PChar(output), len1); - Inc(audio_buf_index, len1); - end; - - result := paContinue; -end; - -function TAudio_FFMpeg.FindAudioStreamID(pFormatCtx : PAVFormatContext): integer; -var - i : integer; - streamID: integer; - stream : PAVStream; -begin - // Find the first audio stream - streamID := -1; - - for i := 0 to pFormatCtx^.nb_streams-1 do - begin - //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); - stream := pFormatCtx^.streams[i]; - - if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then - begin - Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); - streamID := i; - break; - end; - end; - - result := streamID; -end; - -function ParseAudio(data: Pointer): integer; cdecl; -var - packet: TAVPacket; - stream: TFFMpegOutputStream; -begin - stream := TFFMpegOutputStream(data); - - while (av_read_frame(stream.pFormatCtx, packet) >= 0) do - begin - //writeln( 'ffmpeg - av_read_frame' ); - - if (packet.stream_index = stream.ffmpegStreamID) then - begin - //writeln( 'packet_queue_put' ); - stream.packetQueue.put(@packet); - end - else - begin - av_free_packet(packet); - end; - end; - - //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); - - result := 0; -end; - - -function TAudio_FFMpeg.LoadSoundFromFile(Name: string): TFFMpegOutputStream; -var - pFormatCtx : PAVFormatContext; - pCodecCtx : PAVCodecContext; - pCodec : PAVCodec; - ffmpegStreamID : Integer; - ffmpegStream : PAVStream; - wanted_spec, - spec : TSDL_AudioSpec; - csIndex : integer; - stream : TFFMpegOutputStream; - err : TPaError; - // move this to a portaudio specific section - paOutParams : TPaStreamParameters; - paApiInfo : PPaHostApiInfo; - paApi : TPaHostApiIndex; - paOutDevice : TPaDeviceIndex; - paOutDeviceInfo : PPaDeviceInfo; -begin - result := nil; - - if (not FileExists(Name)) then - begin - Log.LogStatus('LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); - writeln('ERROR : LoadSoundFromFile: Sound not found "' + Name + '"', 'UAudio_FFMpeg'); - exit; - end; - - // Open audio file - if (av_open_input_file(pFormatCtx, PChar(Name), nil, 0, nil) > 0) then - exit; - - // Retrieve stream information - if (av_find_stream_info(pFormatCtx) < 0) then - exit; - - dump_format(pFormatCtx, 0, pchar(Name), 0); - - ffmpegStreamID := FindAudioStreamID(pFormatCtx); - if (ffmpegStreamID < 0) then - exit; - - //Log.LogStatus('Audio Stream ID is : '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); - - ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; - pCodecCtx := ffmpegStream^.codec; - - pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); - if (pCodec = nil) then - begin - Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); - exit; - end; - - avcodec_open(pCodecCtx, pCodec); - //writeln( 'Opened the codec' ); - - stream := TFFMpegOutputStream.Create(pFormatCtx, pCodecCtx, pCodec, - ffmpegStreamID, ffmpegStream); - - { - // Set SDL audio settings from codec info - wanted_spec.freq := pCodecCtx^.sample_rate; - wanted_spec.format := AUDIO_S16SYS; - wanted_spec.channels := pCodecCtx^.channels; - wanted_spec.silence := 0; - wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; - wanted_spec.callback := AudioCallback; - wanted_spec.userdata := stream; - - // TODO: this works only one time (?) - if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then - begin - Log.LogStatus('SDL_OpenAudio: '+SDL_GetError(), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - } - - paApi := Pa_HostApiTypeIdToHostApiIndex(paALSA); - paApiInfo := Pa_GetHostApiInfo(paApi); - paOutDevice := paApiInfo^.defaultOutputDevice; - paOutDeviceInfo := Pa_GetDeviceInfo(paOutDevice); - - with paOutParams do begin - device := paOutDevice; - channelCount := pCodecCtx^.channels; - sampleFormat := paInt16; - suggestedLatency := paOutDeviceInfo^.defaultHighOutputLatency; - hostApiSpecificStreamInfo := nil; - end; - - stream.paFrameSize := sizeof(Smallint) * pCodecCtx^.channels; - - err := Pa_OpenStream(stream.paStream, nil, @paOutParams, pCodecCtx^.sample_rate, - paFramesPerBufferUnspecified, //SDL_AUDIO_BUFFER_SIZE div stream.paFrameSize - paNoFlag, @PA_AudioCallback, stream); - if(err <> paNoError) then begin - Log.LogStatus('Pa_OpenDefaultStream: '+Pa_GetErrorText(err), 'UAudio_FFMpeg'); - stream.Free(); - exit; - end; - - Log.LogStatus('Opened audio device', 'UAudio_FFMpeg'); - - //Add CustomSound - csIndex := High(CustomSounds) + 1; - SetLength (CustomSounds, csIndex + 1); - CustomSounds[csIndex].Filename := Name; - CustomSounds[csIndex].Stream := stream; - - result := stream; -end; - -//Equalizer -function TAudio_FFMpeg.GetFFTData: TFFTData; -var - data: TFFTData; -begin - //Get Channel Data Mono and 256 Values -// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - result := data; -end; - -// Interface for Visualizer -function TAudio_FFMpeg.GetPCMData(var data: TPCMData): Cardinal; -begin - result := 0; -end; - -function TAudio_FFMpeg.LoadCustomSound(const Filename: String): Cardinal; -var - S: TFFMpegOutputStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - S := LoadSoundFromFile(SoundPath + Filename); - if (S <> nil) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_FFMpeg.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - (CustomSounds[Index].Stream as TFFMpegOutputStream).Play(); -end; - - -constructor TPacketQueue.Create(); -begin - inherited; - - firstPkt := nil; - lastPkt := nil; - nbPackets := 0; - size := 0; - - mutex := SDL_CreateMutex(); - cond := SDL_CreateCond(); -end; - -function TPacketQueue.Put(pkt : PAVPacket): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - if (av_dup_packet(pkt) < 0) then - exit; - - pkt1 := av_malloc(sizeof(TAVPacketList)); - if (pkt1 = nil) then - exit; - - pkt1^.pkt := pkt^; - pkt1^.next := nil; - - - SDL_LockMutex(Self.mutex); - try - - if (Self.lastPkt = nil) then - Self.firstPkt := pkt1 - else - Self.lastPkt^.next := pkt1; - - Self.lastPkt := pkt1; - inc(Self.nbPackets); - -// Writeln('Put: ' + inttostr(nbPackets)); - - Self.size := Self.size + pkt1^.pkt.size; - SDL_CondSignal(Self.cond); - - finally - SDL_UnlockMutex(Self.mutex); - end; - - result := 0; -end; - -function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; -var - pkt1 : PAVPacketList; -begin - result := -1; - - SDL_LockMutex(Self.mutex); - try - while true do - begin - if (quit) then - exit; - - pkt1 := Self.firstPkt; - - if (pkt1 <> nil) then - begin - Self.firstPkt := pkt1.next; - if (Self.firstPkt = nil) then - Self.lastPkt := nil; - dec(Self.nbPackets); - -// Writeln('Get: ' + inttostr(nbPackets)); - - Self.size := Self.size - pkt1^.pkt.size; - pkt := pkt1^.pkt; - av_free(pkt1); - - result := 1; - break; - end - else - if (not block) then - begin - result := 0; - break; - end - else - begin - SDL_CondWait(Self.cond, Self.mutex); - end; - end; - finally - SDL_UnlockMutex(Self.mutex); - end; -end; - - - -initialization - singleton_MusicFFMpeg := TAudio_FFMpeg.create(); - - writeln( 'UAudio_FFMpeg - Register Playback' ); - AudioManager.add( IAudioPlayback( singleton_MusicFFMpeg ) ); - -finalization - AudioManager.Remove( IAudioPlayback( singleton_MusicFFMpeg ) ); - - -end. diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas deleted file mode 100644 index 972d6df0..00000000 --- a/Game/Code/Classes/UAudio_bass.pas +++ /dev/null @@ -1,703 +0,0 @@ -unit UAudio_bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - bass, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; - -type - TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking, - mpPaused, mpOpen); - -const - ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open'); - -type - TBassOutputStream = class(TAudioOutputStream) - Handle: HSTREAM; - - constructor Create(); overload; - constructor Create(stream: HSTREAM); overload; - end; - -type -{$IFDEF UseBASSInput} - TAudio_bass = class( TInterfacedObject, IAudioPlayback, IAudioInput) -{$ELSE} - TAudio_bass = class( TInterfacedObject, IAudioPlayback) -{$ENDIF} - private - MusicStream: HSTREAM; - - StartSoundStream: HSTREAM; - BackSoundStream: HSTREAM; - SwooshSoundStream: HSTREAM; - ChangeSoundStream: HSTREAM; - OptionSoundStream: HSTREAM; - ClickSoundStream: HSTREAM; - DrumSoundStream: HSTREAM; - HihatSoundStream: HSTREAM; - ClapSoundStream: HSTREAM; - ShuffleSoundStream: HSTREAM; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; - - public - function GetName: String; - - {IAudioOutput interface} - - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - procedure Rewind; - procedure MoveTo(Time: real); - procedure Play; - procedure Pause; //Pause Mod - procedure Stop; - procedure Close; - function Finished: boolean; - function Length: real; - function getPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - - {IAudioInput interface} - {$IFDEF UseBASSInput} - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); - {$ENDIF} - end; - -{$IFDEF UseBASSInput} - TBassSoundCard = class(TGenericSoundCard) - RecordStream: HSTREAM; - end; -{$ENDIF} - - -var - singleton_MusicBass : IAudioPlayback; - - -constructor TBassOutputStream.Create(); -begin - inherited; -end; - -constructor TBassOutputStream.Create(stream: HSTREAM); -begin - Create(); - Handle := stream; -end; - - -function TAudio_bass.GetName: String; -begin - result := 'BASS'; -end; - -procedure TAudio_bass.InitializePlayback; -var - Pet: integer; - S: integer; -begin -// Log.BenchmarkStart(4); -// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - Loaded := false; - Loop := false; - - if not BASS_Init(1, 44100, 0, 0, nil) then - begin - Log.LogError('Could not initialize BASS', 'Error'); - Exit; - end; - -// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - -// Log.LogStatus('Loading Sounds', 'Music Initialize'); - -// Log.BenchmarkStart(4); - LoadSoundFromFile(StartSoundStream, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BackSoundStream, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(SwooshSoundStream, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(ChangeSoundStream, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(OptionSoundStream, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(ClickSoundStream, SoundPath + 'rimshot022b.mp3'); - -// LoadSoundFromFile(DrumSoundStream, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(HihatSoundStream, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(ClapSoundStream, SoundPath + 'claps050b.mp3'); - -// LoadSoundFromFile(ShuffleSoundStream, SoundPath + 'Shuffle.mp3'); - -// Log.BenchmarkEnd(4); -// Log.LogBenchmark('--> Loading Sounds', 4); -end; - -procedure TAudio_bass.SetVolume(Volume: integer); -begin - //Old Sets Wave Volume - //BASS_SetVolume(Volume); - //New: Sets Volume only for this Application - - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -end; - -procedure TAudio_bass.SetMusicVolume(Volume: Integer); -begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - //Set Volume - BASS_ChannelSetAttributes (MusicStream, -1, Volume, -101); -end; - -procedure TAudio_bass.SetLoop(Enabled: boolean); -begin - Loop := Enabled; -end; - -function TAudio_bass.Open(Name: string): boolean; -begin - Loaded := false; - if FileExists(Name) then - begin - MusicStream := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); - - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; - - Result := Loaded; -end; - -procedure TAudio_bass.Rewind; -begin - if Loaded then begin - end; -end; - -procedure TAudio_bass.MoveTo(Time: real); -var - bytes: integer; -begin - bytes := BASS_ChannelSeconds2Bytes(MusicStream, Time); - BASS_ChannelSetPosition(MusicStream, bytes); -end; - -procedure TAudio_bass.Play; -begin - if Loaded then - begin - if Loop then - BASS_ChannelPlay(MusicStream, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class - - BASS_ChannelPlay(MusicStream, False); // for setting position before playing - end; -end; - -procedure TAudio_bass.Pause; //Pause Mod -begin - if Loaded then begin - BASS_ChannelPause(MusicStream); // Pauses Song - end; -end; - -procedure TAudio_bass.Stop; -begin - Bass_ChannelStop(MusicStream); -end; - -procedure TAudio_bass.Close; -begin - Bass_StreamFree(MusicStream); -end; - -function TAudio_bass.Length: real; -var - bytes: integer; -begin - Result := 60; - - bytes := BASS_ChannelGetLength(MusicStream); - Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); -end; - -function TAudio_bass.getPosition: real; -var - bytes: integer; -begin - Result := 0; - - bytes := BASS_ChannelGetPosition(MusicStream); - Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); -end; - -function TAudio_bass.Finished: boolean; -begin - Result := false; - - if BASS_ChannelIsActive(MusicStream) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -end; - -procedure TAudio_bass.PlayStart; -begin - BASS_ChannelPlay(StartSoundStream, True); -end; - -procedure TAudio_bass.PlayBack; -begin - BASS_ChannelPlay(BackSoundStream, True);// then -end; - -procedure TAudio_bass.PlaySwoosh; -begin - BASS_ChannelPlay(SwooshSoundStream, True); -end; - -procedure TAudio_bass.PlayChange; -begin - BASS_ChannelPlay(ChangeSoundStream, True); -end; - -procedure TAudio_bass.PlayOption; -begin - BASS_ChannelPlay(OptionSoundStream, True); -end; - -procedure TAudio_bass.PlayClick; -begin - BASS_ChannelPlay(ClickSoundStream, True); -end; - -procedure TAudio_bass.PlayDrum; -begin - BASS_ChannelPlay(DrumSoundStream, True); -end; - -procedure TAudio_bass.PlayHihat; -begin - BASS_ChannelPlay(HihatSoundStream, True); -end; - -procedure TAudio_bass.PlayClap; -begin - BASS_ChannelPlay(ClapSoundStream, True); -end; - -procedure TAudio_bass.PlayShuffle; -begin - BASS_ChannelPlay(ShuffleSoundStream, True); -end; - -procedure TAudio_bass.StopShuffle; -begin - BASS_ChannelStop(ShuffleSoundStream); -end; - -function TAudio_bass.LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; -var - L: Integer; -begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - stream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Stream := TBassOutputStream.Create(stream); - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end - else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; -end; - -//Equalizer -function TAudio_bass.GetFFTData: TFFTData; -var - Data: TFFTData; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(MusicStream, @Result, BASS_DATA_FFT512); -end; - -{* - * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. - * Returns the number of frames (= stereo/mono sample) - *} -function TAudio_bass.GetPCMData(var data: TPCMData): Cardinal; -var - info: BASS_CHANNELINFO; - nBytes: DWORD; -begin - //Get Channel Data Mono and 256 Values - BASS_ChannelGetInfo(MusicStream, info); - ZeroMemory(@data, sizeof(TPCMData)); - - if (info.chans = 1) then - begin - // mono file -> add stereo channel - { - nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); - // interleave data - //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); - } - result := 0; - end - else - begin - // stereo file - nBytes := BASS_ChannelGetData(MusicStream, @data, sizeof(TPCMData)); - end; - if(nBytes <= 0) then - result := 0 - else - result := nBytes div sizeof(TPCMStereoSample); -end; - -function TAudio_bass.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; -begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; -end; - -procedure TAudio_bass.PlayCustomSound(const Index: Cardinal ); -begin - if Index <= High(CustomSounds) then - with CustomSounds[Index].Stream as TBassOutputStream do - begin - BASS_ChannelPlay(Handle, True); - end; -end; - -{$IFDEF UseBASSInput} - -procedure TAudio_bass.InitializeRecord; -var - device: integer; - Descr: string; - input: integer; - input2: integer; - InputName: PChar; - Flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input - No: integer; - -function isDuplicate(Desc: String): Boolean; -var - I: Integer; -begin - Result := False; - //Check for Soundcard with same Description - For I := 0 to SC-1 do - begin - if (Recording.SoundCard[I].Description = Desc) then - begin - Result := True; - Break; - end; - end; -end; - -begin - with Recording do - begin - // checks for recording devices and puts them into an array - SetLength(SoundCard, 0); - - SC := 0; - Descr := BASS_RecordGetDeviceDescription(SC); - - while (Descr <> '') do - begin - //If there is another SoundCard with the Same ID, Search an available Name - if (IsDuplicate(Descr)) then - begin - No:= 1; //Count of SoundCards with same Name - Repeat - Inc(No) - Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - - //Set Description - Descr := Descr + ' (' + InttoStr(No) + ')'; - end; - - SetLength(SoundCard, SC+1); - - // TODO: free object on termination - SoundCard[SC] := TBassSoundCard.Create(); - SoundCard[SC].Description := Descr; - - //Get Recording Inputs - SCI := 0; - BASS_RecordInit(SC); - - InputName := BASS_RecordGetInputName(SCI); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty - // InputName. So, we have to add a hard coded - // Workaround for this problem - if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then - begin - InputName := 'Microphone'; - end; - {$ENDIF} - - SetLength(SoundCard[SC].Input, 1); - SoundCard[SC].Input[SCI].Name := InputName; - - // process each input - while (InputName <> nil) do - begin - Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then - begin - SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; - end; - - //Set Mic Index - if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then - SoundCard[SC].MicInput := SCI; - - Inc(SCI); - InputName := BASS_RecordGetInputName(SCI); - end; - - BASS_RecordFree; - - Inc(SC); - Descr := BASS_RecordGetDeviceDescription(SC); - end; // while - end; // with Recording -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_bass.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_bass.CaptureStop; -var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); - end; - -end; - -{* - * Bass input capture callback. - * Params: - * stream - BASS input stream - * buffer - buffer of captured samples - * len - size of buffer in bytes - * user - players associated with left/right channels - *} -function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; - len: Cardinal; Card: Cardinal): boolean; stdcall; -begin - Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); - Result := true; -end; - -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudio_bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: integer; - ErrorMsg: string; - bassSoundCard: TBassSoundCard; -begin - if not BASS_RecordInit(Card) then - begin - Error := BASS_ErrorGetCode; - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); - Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); - end - else - begin - bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); - bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; - bassSoundCard.CaptureSoundRight := CaptureSoundRight; - - // capture in 44.1kHz/stereo/16bit and a 20ms callback period - bassSoundCard.RecordStream := - BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); - end; -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - *} -procedure TAudio_bass.StopCard(Card: byte); -begin - BASS_RecordSetDevice(Card); - BASS_RecordFree; -end; - -{$ENDIF} - - -initialization - singleton_MusicBass := TAudio_bass.create(); - AudioManager.add( singleton_MusicBass ); - -finalization - AudioManager.Remove( singleton_MusicBass ); - -end. diff --git a/Game/Code/Classes/UAudio_portaudio.pas b/Game/Code/Classes/UAudio_portaudio.pas deleted file mode 100644 index 47e54981..00000000 --- a/Game/Code/Classes/UAudio_portaudio.pas +++ /dev/null @@ -1,427 +0,0 @@ -unit UAudio_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - Messages, - SysUtils, - {$IFNDEF FPC} - Forms, - {$ENDIF} - portaudio, - {$IFDEF UsePortmixer} - portmixer, - {$ENDIF} - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; -{ -type - TPaHostApiIndex = PaHostApiIndex; - TPaDeviceIndex = PaDeviceIndex; - PPaStream = ^PaStreamPtr; - PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; - TPaStreamCallbackFlags = PaStreamCallbackFlags; - TPaHostApiTypeId = PaHostApiTypeId; - PPaHostApiInfo = ^PaHostApiInfo; - PPaDeviceInfo = ^PaDeviceInfo; - TPaError = PaError; - TPaStreamParameters = PaStreamParameters; -} -type - TAudio_Portaudio = class( TInterfacedObject, IAudioInput ) - private - function GetPreferredApiIndex(): TPaHostApiIndex; - public - function GetName: String; - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); - end; - - TPortaudioSoundCard = class(TGenericSoundCard) - RecordStream: PPaStream; - DeviceIndex: TPaDeviceIndex; - end; - -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - -var - singleton_MusicPortaudio : IAudioInput; - -const - sampleRate: Double = 44100.; - -{* the default API used by Portaudio is the least common denominator - * and might lack efficiency. ApiPreferenceOrder defines the order of - * preferred APIs to use. The first API-type in the list is tried first. If it's - * not available the next is tried, ... - * If none of the preferred APIs was found the default API is used. - * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi - * as an array's only member if you do not have any preferences. - * paDefaultApi also terminates a preferences list but this is optional. - *} -const - paDefaultApi = -1; -var - ApiPreferenceOrder: -{$IF Defined(WIN32)} - // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment - // Note2: Windows Default-API is MME - //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); - array[0..0] of TPaHostApiTypeId = ( paDirectSound ); -{$ELSEIF Defined(LINUX)} - // Note1: Portmixer has no mixer support for paJACK at the moment - // Note2: Not tested, but ALSA might be better than OSS. - array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); -{$ELSEIF Defined(DARWIN)} - // Note: Not tested. - //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$ELSE} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$IFEND} - -function TAudio_Portaudio.GetName: String; -begin - result := 'Portaudio'; -end; - -function TAudio_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; -var - i: integer; -begin - result := -1; - - // select preferred sound-API - for i:= 0 to High(ApiPreferenceOrder) do - begin - if(ApiPreferenceOrder[i] <> paDefaultApi) then begin - // check if API is available - result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); - if(result >= 0) then - break; - end; - end; - - // None of the preferred APIs is available -> use default - if(result < 0) then begin - result := Pa_GetDefaultHostApi(); - end; -end; - -// TODO: should be a function with boolean return type -procedure TAudio_Portaudio.InitializeRecord; -var - i: integer; - apiIndex: TPaHostApiIndex; - apiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - inputCnt: integer; - inputName: string; - SC: integer; // soundcard - SCI: integer; // soundcard input - err: TPaError; - errMsg: string; - paSoundCard: TPortaudioSoundCard; - inputParams: TPaStreamParameters; - stream: PPaStream; - {$IFDEF UsePortmixer} - mixer: PPxMixer; - {$ENDIF} -begin - // TODO: call Pa_Terminate() on termination - err := Pa_Initialize(); - if(err <> paNoError) then begin - Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - // result := false; - Exit; - end; - - apiIndex := GetPreferredApiIndex(); - apiInfo := Pa_GetHostApiInfo(apiIndex); - - SC := 0; - - // init array-size to max. input-devices count - SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL - for i:= 0 to High(Recording.SoundCard) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - // current device is no input device -> skip - if(deviceInfo^.maxInputChannels <= 0) then - continue; - - // TODO: free object on termination - paSoundCard := TPortaudioSoundCard.Create(); - Recording.SoundCard[SC] := paSoundCard; - - // retrieve device-name - deviceName := deviceInfo^.name; - paSoundCard.Description := deviceName; - paSoundCard.DeviceIndex := deviceIndex; - - // setup desired input parameters - with inputParams do begin - device := deviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - // check if device supports our input-format - err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); - if(err <> 0) then begin - // format not supported -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' - + '('+ errMsg +')'); - paSoundCard.Free(); - continue; - end; - - // TODO: retry with mono if stereo is not supported - // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might - // not be set correctly in OSS) - - err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); - if(err <> paNoError) then begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' - + '('+ errMsg +')'); - paSoundCard.Free(); - continue; - end; - - - {$IFDEF UsePortmixer} - - // use default mixer - mixer := Px_OpenMixer(stream, 0); - - // get input count - inputCnt := Px_GetNumInputSources(mixer); - SetLength(paSoundCard.Input, inputCnt); - - // get input names - for SCI := 0 to inputCnt-1 do - begin - inputName := Px_GetInputSourceName(mixer, SCI); - paSoundCard.Input[SCI].Name := inputName; - end; - - Px_CloseMixer(mixer); - - {$ELSE} // !UsePortmixer - - //Pa_StartStream(stream); - // TODO: check if callback was called (this problem may occur on some devices) - //Pa_StopStream(stream); - - Pa_CloseStream(stream); - - // create a standard input source - SetLength(paSoundCard.Input, 1); - paSoundCard.Input[0].Name := 'Standard'; - - {$ENDIF} - - // use default input source - paSoundCard.InputSelected := 0; - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(Recording.SoundCard, SC); - - Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); - - { - SoundCard[SC].InputSelected := Mic[Device]; - } -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_Portaudio.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudio_Portaudio.CaptureStop; -var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); - end; - -end; - -{* - * Portaudio input capture callback. - *} -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); - result := paContinue; -end; - -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudio_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: TPaError; - ErrorMsg: string; - inputParams: TPaStreamParameters; - deviceInfo: PPaDeviceInfo; - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); - paSoundCard.CaptureSoundLeft := CaptureSoundLeft; - paSoundCard.CaptureSoundRight := CaptureSoundRight; - - // get input latency info - deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); - - // set input stream parameters - with inputParams do begin - device := paSoundCard.DeviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); - Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); - - // open input stream - Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, - @MicrophoneCallback, Pointer(paSoundCard)); - if(Error <> paNoError) then begin - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); - //Halt; - end; - - paSoundCard.RecordStream := stream; - - // start capture - Error := Pa_StartStream(stream); - if(Error <> paNoError) then begin - Pa_CloseStream(stream); - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); - //Halt; - end; -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - *} -procedure TAudio_Portaudio.StopCard(Card: byte); -var - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); - stream := paSoundCard.RecordStream; - if(stream <> nil) then begin - Pa_StopStream(stream); - Pa_CloseStream(stream); - end; -end; - - -initialization - singleton_MusicPortaudio := TAudio_Portaudio.create(); - AudioManager.add( singleton_MusicPortaudio ); - -finalization - AudioManager.Remove( singleton_MusicPortaudio ); - -end. diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 52e3434e..c973512d 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -45,8 +45,8 @@ type procedure Pause; procedure Stop; - procedure MoveTo(Time: real); - function getPosition: real; + procedure SetPosition(Time: real); + function GetPosition: real; procedure GetFrame(Time: Extended); procedure DrawGL(Screen: integer); @@ -82,8 +82,6 @@ type procedure PlayShuffle; procedure StopShuffle; - function LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; - function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); @@ -135,7 +133,7 @@ procedure Tmedia_dummy.Stop; begin end; -procedure Tmedia_dummy.MoveTo(Time: real); +procedure Tmedia_dummy.SetPosition(Time: real); begin end; @@ -251,11 +249,6 @@ procedure Tmedia_dummy.StopShuffle; begin end; -function Tmedia_dummy.LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; -begin - result := false; -end; - function Tmedia_dummy.LoadCustomSound(const Filename: String): Cardinal; begin result := 0; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index c2d616ec..bf366130 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -83,17 +83,72 @@ type Source: array of string; end; +type TFFTData = array[0..256] of Single; TPCMStereoSample = array[0..1] of Smallint; TPCMData = array[0..511] of TPCMStereoSample; - TAudioOutputStream = class +type + TStreamStatus = (sStopped, sPlaying, sPaused); +const + StreamStatusStr: array[TStreamStatus] of string = ('Stopped', 'Playing', 'Paused'); + +type + TAudioProcessingStream = class + public + procedure Close(); virtual; abstract; + end; + + TAudioPlaybackStream = class(TAudioProcessingStream) + protected + function GetLoop(): boolean; virtual; abstract; + procedure SetLoop(Enabled: boolean); virtual; abstract; + function GetLength(): real; virtual; abstract; + function GetStatus(): TStreamStatus; virtual; abstract; + public + procedure Play(); virtual; abstract; + procedure Pause(); virtual; abstract; + procedure Stop(); virtual; abstract; + + property Loop: boolean READ GetLoop WRITE SetLoop; + property Length: real READ GetLength; + property Status: TStreamStatus READ GetStatus; end; + (* + TAudioMixerStream = class(TAudioProcessingStream) + procedure AddStream(stream: TAudioProcessingStream); + procedure RemoveStream(stream: TAudioProcessingStream); + procedure SetMasterVolume(volume: cardinal); + function GetMasterVolume(): cardinal; + procedure SetStreamVolume(stream: TAudioProcessingStream; volume: cardinal); + function GetStreamVolume(stream: TAudioProcessingStream): cardinal; + end; + *) + + TAudioDecodeStream = class(TAudioProcessingStream) + protected + function GetLength(): real; virtual; abstract; + function GetChannelCount(): cardinal; virtual; abstract; + function GetSampleRate(): cardinal; virtual; abstract; + function GetPosition(): real; virtual; abstract; + procedure SetPosition(Time: real); virtual; abstract; + function IsEOF(): boolean; virtual; abstract; + public + function ReadData(Buffer: PChar; BufSize: integer): integer; virtual; abstract; + + property Length: real READ GetLength; + property ChannelCount: cardinal READ GetChannelCount; + property SampleRate: cardinal READ GetSampleRate; + property Position: real READ GetPosition WRITE SetPosition; + property EOF: boolean READ IsEOF; + end; + +type TCustomSoundEntry = record Filename : String; - Stream : TAudioOutputStream; + Stream : TAudioPlaybackStream; end; type @@ -101,23 +156,23 @@ type ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] function GetName: String; - function Open(Name: string): boolean; // true if succeed + function Open(Filename: string): boolean; // true if succeed procedure Close; procedure Play; procedure Pause; procedure Stop; - procedure MoveTo(Time: real); - function getPosition: real; - - property position : real READ getPosition WRITE MoveTo; + procedure SetPosition(Time: real); + function GetPosition: real; + + property Position : real READ GetPosition WRITE SetPosition; end; IVideoPlayback = Interface( IGenericPlayback ) ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] procedure init(); - + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC @@ -150,9 +205,6 @@ type procedure PlayShuffle; procedure StopShuffle; - // TODO - //function LoadSoundFromFile(var stream: TAudioOutputStream; Name: string): boolean; - //Custom Sounds function LoadCustomSound(const Filename: String): Cardinal; procedure PlayCustomSound(const Index: Cardinal ); @@ -164,6 +216,24 @@ type function GetPCMData(var data: TPCMData): Cardinal; end; + IGenericDecoder = Interface + ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] + function InitializeDecoder(): boolean; + //function IsSupported(const Filename: string): boolean; + end; + + (* + IVideoDecoder = Interface( IGenericDecoder ) + ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] + function Open(const Filename: string): TVideoDecodeStream; + end; + *) + + IAudioDecoder = Interface( IGenericDecoder ) + ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] + function Open(const Filename: string): TAudioDecodeStream; + end; + IAudioInput = Interface ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] function GetName: String; @@ -191,6 +261,7 @@ function Visualization(): IVideoPlayback; function VideoPlayback(): IVideoPlayback; function AudioPlayback(): IAudioPlayback; function AudioInput(): IAudioInput; +function AudioDecoder(): IAudioDecoder; function AudioManager: TInterfaceList; @@ -207,6 +278,7 @@ var singleton_Visualization : IVideoPlayback = nil; singleton_AudioPlayback : IAudioPlayback = nil; singleton_AudioInput : IAudioInput = nil; + singleton_AudioDecoder : IAudioDecoder = nil; singleton_AudioManager : TInterfaceList = nil; @@ -240,6 +312,11 @@ begin result := singleton_AudioInput; end; +function AudioDecoder(): IAudioDecoder; +begin + result := singleton_AudioDecoder; +end; + procedure InitializeSound; var lTmpInterface : IInterface; @@ -249,6 +326,7 @@ begin singleton_AudioPlayback := nil; singleton_AudioInput := nil; + singleton_AudioDecoder := nil; singleton_VideoPlayback := nil; singleton_Visualization := nil; @@ -271,6 +349,13 @@ begin singleton_AudioInput := IAudioInput( lTmpInterface ); end; + // if this interface is a Decoder, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioDecoder, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_AudioDecoder := IAudioDecoder( lTmpInterface ); + end; + // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND ( true ) then @@ -293,6 +378,11 @@ begin begin end; + if AudioDecoder <> nil then + begin + AudioDecoder.InitializeDecoder; + end; + if AudioPlayback <> nil then begin AudioPlayback.InitializePlayback; diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 4f6b566a..bbd03d84 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -45,9 +45,11 @@ uses SDL, dialogs, {$endif} {$ENDIF} + (* FIXME {$ifdef UseFFMpegAudio} - UAudio_FFMpeg, + UAudioDecoder_FFMpeg, {$endif} + *) UIni, UMusic, UGraphic; @@ -101,8 +103,8 @@ type procedure Pause; procedure Stop; - procedure MoveTo(Time: real); - function getPosition: real; + procedure SetPosition(Time: real); + function GetPosition: real; procedure GetFrame(Time: Extended); procedure DrawGL(Screen: integer); @@ -626,7 +628,7 @@ procedure TVideoPlayback_ffmpeg.Stop; begin end; -procedure TVideoPlayback_ffmpeg.MoveTo(Time: real); +procedure TVideoPlayback_ffmpeg.SetPosition(Time: real); begin fVideoSkipTime := Time; @@ -639,7 +641,7 @@ begin end; // what is this supposed to do? return VideoTime? -function TVideoPlayback_ffmpeg.getPosition: real; +function TVideoPlayback_ffmpeg.GetPosition: real; begin result := 0; end; diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 5fc4bb82..22c168a2 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -61,9 +61,7 @@ type VisualTex : glUint; PCMData : TPCMData; - hRC : Integer; - hDC : Integer; - + RndPCMcount : integer; projMatrix: array[0..3, 0..3] of GLdouble; @@ -91,8 +89,8 @@ type procedure Pause; procedure Stop; - procedure MoveTo(Time: real); - function getPosition: real; + procedure SetPosition(Time: real); + function GetPosition: real; procedure GetFrame(Time: Extended); procedure DrawGL(Screen: integer); @@ -150,12 +148,12 @@ begin VisualizerStop(); end; -procedure TVideoPlayback_ProjectM.MoveTo(Time: real); +procedure TVideoPlayback_ProjectM.SetPosition(Time: real); begin pm.RandomPreset(); end; -function TVideoPlayback_ProjectM.getPosition: real; +function TVideoPlayback_ProjectM.GetPosition: real; begin result := 0; end; @@ -240,7 +238,6 @@ end; procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); var - i: integer; nSamples: cardinal; stackDepth: Integer; begin @@ -269,7 +266,7 @@ begin // this may happen with some presets ( on linux ) if there is a div by zero // in projectM's getBeatVals() function (file: beat_detect.cc) Log.LogStatus('Div by zero!', 'Visualizer'); - MoveTo( now ); + SetPosition( now ); end; //glGetIntegerv(GL_PROJECTION_STACK_DEPTH, @stackDepth); -- cgit v1.2.3 From fa4f747ca8b83247981e89ec83b21d8f6a7ffa84 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 11 Jan 2008 18:06:15 +0000 Subject: SDL_Init(SDL_INIT_AUDIO) prevents Portaudio from acquiring the soundcard (no sound). Use SDL_Init_Subsystem(SDL_INIT_AUDIO) if SDL is used instead of Portaudio for audio output. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@787 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 7c3ad9d4..e2e0eaa0 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -174,7 +174,7 @@ begin // SDL Log.BenchmarkStart(1); Log.LogStatus('Initialize SDL', 'Initialization'); - SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO); + SDL_Init(SDL_INIT_VIDEO); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing SDL', 1); -- cgit v1.2.3 From e74bd57c12f470257111c1c0530fb38f0fd34414 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 12 Jan 2008 12:31:43 +0000 Subject: bunch of smaller changes... some changes to song loading... Record global changed to singleton object started implementing mic volume display in Settings-Record hope this dosnt break anything.. :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@789 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioInput_Bass.pas | 23 ++- Game/Code/Classes/UCommandLine.pas | 5 +- Game/Code/Classes/UDataBase.pas | 1 + Game/Code/Classes/UDraw.pas | 28 ++- Game/Code/Classes/UFiles.pas | 360 +++------------------------------ Game/Code/Classes/UIni.pas | 10 +- Game/Code/Classes/ULog.pas | 6 +- Game/Code/Classes/UMain.pas | 86 ++++---- Game/Code/Classes/UMusic.pas | 1 + Game/Code/Classes/UPlatform.pas | 74 ++----- Game/Code/Classes/UPlatformLinux.pas | 2 +- Game/Code/Classes/UPlatformMacOSX.pas | 20 +- Game/Code/Classes/UPlatformWindows.pas | 59 +++++- Game/Code/Classes/URecord.pas | 81 ++++++-- Game/Code/Classes/USongs.pas | 259 ++++++++++-------------- 15 files changed, 375 insertions(+), 640 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioInput_Bass.pas b/Game/Code/Classes/UAudioInput_Bass.pas index 9807ffc3..75a5aee5 100644 --- a/Game/Code/Classes/UAudioInput_Bass.pas +++ b/Game/Code/Classes/UAudioInput_Bass.pas @@ -79,7 +79,7 @@ begin //Check for Soundcard with same Description For I := 0 to SC-1 do begin - if (Recording.SoundCard[I].Description = Desc) then + if (AudioInputProcessor.SoundCard[I].Description = Desc) then begin Result := True; Break; @@ -88,7 +88,7 @@ begin end; begin - with Recording do + with AudioInputProcessor do begin // checks for recording devices and puts them into an array SetLength(SoundCard, 0); @@ -170,21 +170,22 @@ var PlayerLeft, PlayerRight: integer; CaptureSoundLeft, CaptureSoundRight: TSound; begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; + for S := 0 to High(AudioInputProcessor.Sound) do + AudioInputProcessor.Sound[S].BufferLong[0].Clear; - for SC := 0 to High(Ini.CardList) do begin + for SC := 0 to High(Ini.CardList) do + begin PlayerLeft := Ini.CardList[SC].ChannelL-1; PlayerRight := Ini.CardList[SC].ChannelR-1; if PlayerLeft >= PlayersPlay then PlayerLeft := -1; if PlayerRight >= PlayersPlay then PlayerRight := -1; if (PlayerLeft > -1) or (PlayerRight > -1) then begin if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] + CaptureSoundLeft := AudioInputProcessor.Sound[PlayerLeft] else CaptureSoundLeft := nil; if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] + CaptureSoundRight := AudioInputProcessor.Sound[PlayerRight] else CaptureSoundRight := nil; @@ -224,14 +225,14 @@ end; function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; len: Cardinal; Card: Cardinal): boolean; stdcall; begin - Recording.HandleMicrophoneData(buffer, len, Recording.SoundCard[Card]); + AudioInputProcessor.HandleMicrophoneData(buffer, len, AudioInputProcessor.SoundCard[Card]); Result := true; end; {* * Start input-capturing on Soundcard specified by Card. * Params: - * Card - soundcard index in Recording.SoundCard array + * Card - soundcard index in AudioInputProcessor.SoundCard array * CaptureSoundLeft - sound(-buffer) used for left channel capture data * CaptureSoundRight - sound(-buffer) used for right channel capture data *} @@ -254,7 +255,7 @@ begin end else begin - bassSoundCard := TBassSoundCard(Recording.SoundCard[Card]); + bassSoundCard := TBassSoundCard(AudioInputProcessor.SoundCard[Card]); bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; bassSoundCard.CaptureSoundRight := CaptureSoundRight; @@ -267,7 +268,7 @@ end; {* * Stop input-capturing on Soundcard specified by Card. * Params: - * Card - soundcard index in Recording.SoundCard array + * Card - soundcard index in AudioInputProcessor.SoundCard array *} procedure TAudioInput_Bass.StopCard(Card: byte); begin diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas index 86f822a4..55dfc6ce 100644 --- a/Game/Code/Classes/UCommandLine.pas +++ b/Game/Code/Classes/UCommandLine.pas @@ -61,7 +61,8 @@ const implementation -uses SysUtils; +uses SysUtils, + uPlatform; // uINI -- Nasty requirement... ( removed with permission of blindy ) @@ -99,7 +100,7 @@ begin writeln( '' ); - halt; + platform.halt; end; //------------- diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index e99cb891..b5636d52 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -9,6 +9,7 @@ interface {$I switches.inc} uses USongs, + USong, SQLiteTable3; //-------------------- diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index c399057b..662050dc 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -161,7 +161,7 @@ end; procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); var - Pet: integer; + Pet : integer; begin; // Log.LogStatus('Oscilloscope', 'SingDraw'); glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); @@ -169,14 +169,19 @@ begin; glColor3f(1, 1, 1); } glBegin(GL_LINE_STRIP); - glVertex2f(X, -Recording.Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); - for Pet := 2 to Recording.Sound[NrSound].n div 1 do begin - glVertex2f(X + (Pet-1) * W / (Recording.Sound[NrSound].n - 1), - -Recording.Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2); + + glVertex2f(X, -AudioInputProcessor.Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + + for Pet := 2 to AudioInputProcessor.Sound[NrSound].n div 1 do + begin + glVertex2f( X + (Pet-1) * W / (AudioInputProcessor.Sound[NrSound].n - 1), + -AudioInputProcessor.Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2 ); end; glEnd; end; + + procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); var Pet: integer; @@ -366,7 +371,7 @@ var glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - if Player[NrGracza].IlNut > 0 then +//// if Player[NrGracza].IlNut > 0 then begin TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); for N := 0 to Player[NrGracza].HighNut do @@ -480,14 +485,7 @@ begin lTmpA := (Right-Left); lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); - - {$IFDEF LAZARUS} -{* - writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); - writeln( 'UDRAW : ' + floattostr( lTmpB ) ); - writeln( '' ); -*} - {$ENDIF} + if ( lTmpA > 0 ) AND ( lTmpB > 0 ) THEN @@ -555,7 +553,7 @@ begin end; // if not FreeStyle end; // with end; // for - end; // with + end; // with 1 glDisable(GL_BLEND); glDisable(GL_TEXTURE_2D); diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 69beefe9..d3e4729b 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -10,45 +10,33 @@ interface uses SysUtils, ULog, UMusic, - USongs; + USongs, + USong; //procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs -function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header -function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header -procedure ClearSong(var Song: TSong); //Clears Song Header values +//function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header +//function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header +//procedure ClearSong(var Song: TSong); //Clears Song Header values //Methodes Loading and Saving Songfiles procedure ResetSingTemp; -procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); -function LoadSong(Name: string): boolean; +//procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +//procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); + +//function LoadSong(Name: string): boolean; function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; var -{* - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; -*} - SongFile: TextFile; // all procedures in this unit operates on this file FileLineNo: integer; //Line which is readed at Last, for error reporting // variables available for all procedures - Base: array[0..1] of integer; - Rel: array[0..1] of integer; - Mult: integer = 1; - MultBPM: integer = 4; + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer = 1; + MultBPM : integer = 4; implementation @@ -57,7 +45,10 @@ uses TextGL, UPlatform, UMain; +(* //-------------------- +<<<<<<< .mine +======= // Clears Song Header values //-------------------- procedure ClearSong(var Song: TSong); @@ -367,7 +358,7 @@ Result := False; Log.LogError('An Error occured reading Line ' + inttostr(FileLineNo) + ' from SongHeader: ' + Song.FileName); end;} end; - + *) //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables //-------------------- @@ -376,7 +367,6 @@ var Pet: integer; begin SetLength(Czesci, Length(Player)); - SetLength(AktSong.BPM, 0); for Pet := 0 to High(Player) do begin SetLength(Czesci[Pet].Czesc, 1); SetLength(Czesci[Pet].Czesc[0].Nuta, 0); @@ -386,316 +376,18 @@ begin Player[pet].IlNut := 0; Player[pet].HighNut := -1; end; - //Reset Path and Filename Values to Prevent Errors in Editor - AktSong.Path := ''; - AktSong.FileName := ''; -end; - -//-------------------- -// Parses Note Infos and save them to Array -//-------------------- -procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -var - Space: boolean; -begin - case Ini.Solmization of - 1: // european - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' si '; - end; - end; - 2: // japanese - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' so '; - 9..10: LyricS := ' la '; - 11: LyricS := ' shi '; - end; - end; - 3: // american - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' ti '; - end; - end; - end; // case - - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin - SetLength(Nuta, Length(Nuta) + 1); - IlNut := IlNut + 1; - HighNut := HighNut + 1; - Muzyka.IlNut := Muzyka.IlNut + 1; - - Nuta[HighNut].Start := StartP; - if IlNut = 1 then begin - StartNote := Nuta[HighNut].Start; - if Czesci[NrCzesci].Ilosc = 1 then - Start := -100; -// Start := Nuta[HighNut].Start; - end; - - Nuta[HighNut].Dlugosc := DurationP; - Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; - - // back to the normal system with normal, golden and now freestyle notes - case TypeP of - 'F': Nuta[HighNut].Wartosc := 0; - ':': Nuta[HighNut].Wartosc := 1; - '*': Nuta[HighNut].Wartosc := 2; - end; - - Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; - Nuta[HighNut].Ton := NoteP; - if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; - Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; - - Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); - Lyric := Lyric + Nuta[HighNut].Tekst; - - if TypeP = 'F' then - Nuta[HighNut].FreeStyle := true; - - Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; - end; // with -end; - -//-------------------- -// Called when a new Sentence is found in the TXT File -//-------------------- -procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); -var -I: Integer; -begin - - // stara czesc //Alter Satz //Update Old Part - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); - - //Total Notes Patch - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; - for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + //Reset Path and Filename Values to Prevent Errors in Editor + if assigned( CurrentSong ) then begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + SetLength(CurrentSong.BPM, 0); + CurrentSong.Path := ''; + CurrentSong.FileName := ''; end; - //Total Notes Patch End - - - // nowa czesc //Neuer Satz //Update New Part - SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); - Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; - Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; - - if not AktSong.Relative then - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - - if AktSong.Relative then begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; - end; - - Base[NrCzesciP] := 100; // high number + +// CurrentSong := nil; end; -//-------------------- -// Load a Song -//-------------------- -function LoadSong(Name: string): boolean; -var - TempC: char; - Tekst: string; - CP: integer; // Current Player (0 or 1) - Pet: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I: Integer; -begin - Result := false; - - if not FileExists(Name) then begin - Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci'); - exit; - end; - - try - MultBPM := 4; // 4 - mnoznik dla czasu nut - Mult := 1; // 4 - dokladnosc pomiaru nut - Base[0] := 100; // high number -// Base[1] := 100; // high number - Czesci[0].Wartosc := 0; -// Czesci[1].Wartosc := 0; // here was the error in 0.3.2 - AktSong.Relative := false; - - Rel[0] := 0; -// Rel[1] := 0; - CP := 0; - Both := false; - if Length(Player) = 2 then Both := true; - - FileMode := fmOpenRead; - AssignFile(SongFile, Name); - Reset(SongFile); - - //Clear old Song Header - ClearSong(AktSong); - - if (AktSong.Path = '') then - AktSong.Path := ExtractFilePath(Name); - - if (AktSong.FileName = '') then - AktSong.Filename := ExtractFileName(Name); - //Read Header - Result := ReadTxTHeader(AktSong); - if not Result then - begin - CloseFile(SongFile); - Log.LogError('Error Loading SongHeader, abort Song Loading'); - Exit; - end; - - Result := False; - - Reset(SongFile); - FileLineNo := 0; - //Search for Note Begining - repeat - ReadLn(SongFile, Tekst); - Inc(FileLineNo); - - if (EoF(SongFile)) then - begin //Song File Corrupted - No Notes - CloseFile(SongFile); - Log.LogError('Could not load txt File, no Notes found: ' + Name); - Result := False; - Exit; - end; - Read(SongFile, TempC); - until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); - - SetLength(Czesci, 2); - for Pet := 0 to High(Czesci) do begin - SetLength(Czesci[Pet].Czesc, 1); - Czesci[Pet].High := 0; - Czesci[Pet].Ilosc := 1; - Czesci[Pet].Akt := 0; - Czesci[Pet].Resolution := AktSong.Resolution; - Czesci[Pet].NotesGAP := AktSong.NotesGAP; - Czesci[Pet].Czesc[0].IlNut := 0; - Czesci[Pet].Czesc[0].HighNut := -1; - end; - -// TempC := ':'; -// TempC := Tekst[1]; // read from backup variable, don't use default ':' value - - while (TempC <> 'E') AND (not EOF(SongFile)) do begin - if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin - // wczytuje nute - Read(SongFile, Param1); - Read(SongFile, Param2); - Read(SongFile, Param3); - Read(SongFile, ParamS); - - // dodaje nute - if not Both then - // P1 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else begin - // P1 + P2 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - end; // if - if TempC = '-' then begin - // reads sentence - Read(SongFile, Param1); - if AktSong.Relative then Read(SongFile, Param2); // read one more data for relative system - - // new sentence - if not Both then - // P1 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) - else begin - // P1 + P2 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); - NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); - end; - - end; // if - - if TempC = 'B' then begin - SetLength(AktSong.BPM, Length(AktSong.BPM) + 1); - Read(SongFile, AktSong.BPM[High(AktSong.BPM)].StartBeat); - AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0]; - - Read(SongFile, Tekst); - AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst); - AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM; - end; - - - if not Both then begin - Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; - Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); - //Total Notes Patch - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; - for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do - begin - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end else begin - for Pet := 0 to High(Czesci) do begin - Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; - Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); - //Total Notes Patch - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; - for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do - begin - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end; - end; - - Read(SongFile, TempC); - Inc(FileLineNo); - end; // while} - - CloseFile(SongFile); - except - try - CloseFile(SongFile); - except - - end; - - Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(FileLineNo)); - exit; - end; - - Result := true; -end; //-------------------- // Saves a Song @@ -738,8 +430,8 @@ begin WriteLn(SongFile, '#GAP:' + FloatToStr(Song.GAP)); RelativeSubTime := 0; - for B := 1 to High(AktSong.BPM) do - WriteLn(SongFile, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4)); + for B := 1 to High(CurrentSong.BPM) do + WriteLn(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4)); for C := 0 to Czesc.High do begin for N := 0 to Czesc.Czesc[C].HighNut do begin diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index e4f5e823..599bb8fa 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -463,9 +463,9 @@ begin //{ B := False; //Look for Soundcard - for I2 := 0 to High(Recording.SoundCard) do + for I2 := 0 to High(AudioInputProcessor.SoundCard) do begin - if (S = Trim(Recording.SoundCard[I2].Description)) then + if (S = Trim(AudioInputProcessor.SoundCard[I2].Description)) then begin B := True; Break; @@ -485,12 +485,12 @@ begin end; // Record - append detected soundcards - for I := 0 to High(Recording.SoundCard) do + for I := 0 to High(AudioInputProcessor.SoundCard) do begin B := False; For I2 := 0 to High(CardList) do begin //Search for Card in List - if (CardList[I2].Name = Trim(Recording.SoundCard[I].Description)) then + if (CardList[I2].Name = Trim(AudioInputProcessor.SoundCard[I].Description)) then begin B := True; Break; @@ -502,7 +502,7 @@ begin begin I3 := Length(CardList); SetLength(CardList, I3+1); - CardList[I3].Name := Trim(Recording.SoundCard[I].Description); + CardList[I3].Name := Trim(AudioInputProcessor.SoundCard[I].Description); CardList[I3].Input := 0; CardList[I3].ChannelL := 0; CardList[I3].ChannelR := 0; diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index fc567d54..49b02c00 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -212,9 +212,9 @@ begin FS := TFileStream.Create(FileName, fmCreate); - for BL := 0 to High(Recording.Sound[SoundNr].BufferLong) do begin - Recording.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); - FS.CopyFrom(Recording.Sound[SoundNr].BufferLong[BL], Recording.Sound[SoundNr].BufferLong[BL].Size); + for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin + AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); + FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size); end; FS.Free; diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index e2e0eaa0..901d7370 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -20,6 +20,7 @@ uses ULog, ULyrics, UScreenSing, + USong, OpenGL12, {$IFDEF UseSerialPort} zlportio {you can disable it and all PortWriteB calls}, @@ -107,6 +108,8 @@ var Player: array of TPlayer; PlayersPlay: integer; + CurrentSong : TSong; + procedure InitializePaths; Procedure Main; @@ -130,7 +133,7 @@ uses USongs, math, UCommandLine, ULanguage, SDL_ttf, USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, - UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; + UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; const Version = 'UltraStar Deluxe V 1.10 Alpha Build'; @@ -192,12 +195,14 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Skin List', 1); +(* // Sound Card List Log.BenchmarkStart(1); Log.LogStatus('Loading Soundcard list', 'Initialization'); Recording := TRecord.Create; Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Soundcard list', 1); +*) // Sound (+ fills Sound Card List) Log.BenchmarkStart(1); @@ -508,23 +513,23 @@ procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); var NewTime: real; begin - if High(AktSong.BPM) = BPMNum then begin + if High(CurrentSong.BPM) = BPMNum then begin // last BPM - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); Time := 0; end else begin // not last BPM // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(AktSong.BPM[BPMNum].BPM, AktSong.BPM[BPMNum+1].StartBeat - AktSong.BPM[BPMNum].StartBeat); + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); // compare it to remaining time if (Time - NewTime) > 0 then begin // there is still remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat; + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; Time := Time - NewTime; end else begin // there is no remaining time - CurBeat := AktSong.BPM[BPMNum].StartBeat + GetBeats(AktSong.BPM[BPMNum].BPM, Time); + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); Time := 0; end; // if end; // if @@ -539,18 +544,18 @@ var // TempTime: real; begin Result := 0; - if Length(AktSong.BPM) = 1 then Result := Time * AktSong.BPM[0].BPM / 60; + if Length(CurrentSong.BPM) = 1 then Result := Time * CurrentSong.BPM[0].BPM / 60; (* 2 BPMs *) -{ if Length(AktSong.BPM) > 1 then begin +{ if Length(CurrentSong.BPM) > 1 then begin (* new system *) CurBeat := 0; - TopBeat := GetBeats(AktSong.BPM[0].BPM, Time); - if TopBeat > AktSong.BPM[1].StartBeat then begin + TopBeat := GetBeats(CurrentSong.BPM[0].BPM, Time); + if TopBeat > CurrentSong.BPM[1].StartBeat then begin // analyze second BPM - Time := Time - GetTimeForBeats(AktSong.BPM[0].BPM, AktSong.BPM[1].StartBeat - CurBeat); - CurBeat := AktSong.BPM[1].StartBeat; - TopBeat := GetBeats(AktSong.BPM[1].BPM, Time); + Time := Time - GetTimeForBeats(CurrentSong.BPM[0].BPM, CurrentSong.BPM[1].StartBeat - CurBeat); + CurBeat := CurrentSong.BPM[1].StartBeat; + TopBeat := GetBeats(CurrentSong.BPM[1].BPM, Time); Result := CurBeat + TopBeat; end else begin @@ -560,7 +565,7 @@ begin end; // if} (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin + if Length(CurrentSong.BPM) > 1 then begin CurBeat := 0; CurBPM := 0; @@ -578,21 +583,21 @@ var CurBPM: integer; begin Result := 0; - if Length(AktSong.BPM) = 1 then Result := AktSong.GAP / 1000 + Beat * 60 / AktSong.BPM[0].BPM; + if Length(CurrentSong.BPM) = 1 then Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; (* more BPMs *) - if Length(AktSong.BPM) > 1 then begin - Result := AktSong.GAP / 1000; + if Length(CurrentSong.BPM) > 1 then begin + Result := CurrentSong.GAP / 1000; CurBPM := 0; - while (CurBPM <= High(AktSong.BPM)) and (Beat > AktSong.BPM[CurBPM].StartBeat) do begin - if (CurBPM < High(AktSong.BPM)) and (Beat >= AktSong.BPM[CurBPM+1].StartBeat) then begin + while (CurBPM <= High(CurrentSong.BPM)) and (Beat > CurrentSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(CurrentSong.BPM)) and (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then begin // full range - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (AktSong.BPM[CurBPM+1].StartBeat - AktSong.BPM[CurBPM].StartBeat); + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); end; - if (CurBPM = High(AktSong.BPM)) or (Beat < AktSong.BPM[CurBPM+1].StartBeat) then begin + if (CurBPM = High(CurrentSong.BPM)) or (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then begin // in the middle - Result := Result + (60 / AktSong.BPM[CurBPM].BPM) * (Beat - AktSong.BPM[CurBPM].StartBeat); + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (Beat - CurrentSong.BPM[CurBPM].StartBeat); end; Inc(CurBPM); end; @@ -615,7 +620,7 @@ begin Czas.Teraz := Czas.Teraz + TimeSkip; Czas.OldBeat := Czas.AktBeat; - Czas.MidBeat := GetMidBeat(Czas.Teraz - (AktSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.MidBeat := GetMidBeat(Czas.Teraz - (CurrentSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function Czas.AktBeat := Floor(Czas.MidBeat); // Czas.OldHalf := Czas.AktHalf; @@ -623,11 +628,11 @@ begin // Czas.AktHalf := Floor(Czas.MidHalf); Czas.OldBeatC := Czas.AktBeatC; - Czas.MidBeatC := GetMidBeat(Czas.Teraz - (AktSong.Gap) / 1000); + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (CurrentSong.Gap) / 1000); Czas.AktBeatC := Floor(Czas.MidBeatC); Czas.OldBeatD := Czas.AktBeatD; - Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (AktSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (CurrentSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP Czas.AktBeatD := Floor(Czas.MidBeatD); Czas.FracBeatD := Frac(Czas.MidBeatD); @@ -822,7 +827,7 @@ begin // beep; // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas - if not assigned( Recording.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. + if not assigned( AudioInputProcessor.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. exit; // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) @@ -831,7 +836,7 @@ begin begin // analyze buffer - Recording.Sound[CP].AnalizujBufor; + AudioInputProcessor.Sound[CP].AnalyzeBuffer; // adds some noise // Czas.Ton := Czas.Ton + Round(Random(3)) - 1; @@ -866,7 +871,7 @@ begin // Czas.Ton := 27; // gdy moze, to dodaje nute - if (Recording.Sound[CP].SzczytJest) and (Mozna) then begin + if (AudioInputProcessor.Sound[CP].SzczytJest) and (Mozna) then begin // operowanie na ostatniej nucie for Pet := 0 to Czesci[0].Czesc[S].HighNut do if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) @@ -875,10 +880,11 @@ begin // to robi, tylko dla pary nut (oryginalnej i gracza) // przesuwanie tonu w odpowiednia game - while (Recording.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - Recording.Sound[CP].Ton := Recording.Sound[CP].Ton - 12; - while (Recording.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - Recording.Sound[CP].Ton := Recording.Sound[CP].Ton + 12; + while (AudioInputProcessor.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + AudioInputProcessor.Sound[CP].Ton := AudioInputProcessor.Sound[CP].Ton - 12; + + while (AudioInputProcessor.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + AudioInputProcessor.Sound[CP].Ton := AudioInputProcessor.Sound[CP].Ton + 12; // Half size Notes Patch NoteHit := false; @@ -887,8 +893,9 @@ begin //if Ini.Difficulty = 1 then Range := 1; //if Ini.Difficulty = 2 then Range := 0; Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - Recording.Sound[CP].Ton) <= Range then begin - Recording.Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Ton) <= Range then begin + AudioInputProcessor.Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; // Half size Notes Patch @@ -929,7 +936,7 @@ begin Nowa := true; // jezeli ostatnia ma ten sam ton if (Player[CP].IlNut > 0 ) - and (Player[CP].Nuta[Player[CP].HighNut].Ton = Recording.Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Ton) and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) then Nowa := false; // jezeli jest jakas nowa nuta na sprawdzanym beacie @@ -943,10 +950,10 @@ begin Player[CP].IlNut := Player[CP].IlNut + 1; Player[CP].HighNut := Player[CP].HighNut + 1; SetLength(Player[CP].Nuta, Player[CP].IlNut); - Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := Recording.Sound[CP].Ton; // Ton || TonDokl - Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; // Half Note Patch @@ -977,7 +984,8 @@ begin //On Sentence End -> For LineBonus + SingBar if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then -if ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then +if assigned( Sender ) AND + ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then Sender.onSentenceEnd(sDet); end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index bf366130..a7f1918f 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -413,6 +413,7 @@ end; initialization begin singleton_AudioManager := TInterfaceList.Create(); + end; finalization diff --git a/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas index 19a960e7..bfb03d54 100644 --- a/Game/Code/Classes/UPlatform.pas +++ b/Game/Code/Classes/UPlatform.pas @@ -16,7 +16,6 @@ interface uses Classes; type - TDirectoryEntry = Record Name : WideString; IsDirectory : Boolean; @@ -27,33 +26,16 @@ type IPlatform = Interface ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCA23DF}'] - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; - function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; - - function GetLogPath : WideString; - function GetGameSharedPath : WideString; - function GetGameUserPath : WideString; - end; - - TPlatform = class( TInterfacedOBject, IPlatform ) - - // DirectoryFindFiles returns all files matching the filter. Do not use '*' in the filter. - // If you set ReturnAllSubDirs = true all directories will be returned, if yout set it to false - // directories are completely ignored. - function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; virtual; abstract; - - function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; virtual; - -// function GetGamePath : WideString; virtual; - function GetLogPath : WideString; virtual; - function GetGameSharedPath : WideString; virtual; - function GetGameUserPath : WideString; virtual; - + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + function FindSongFile(Dir, Mask: widestring): widestring; + procedure halt; + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; end; - -var - Platform : IPlatform; + function Platform : IPlatform; implementation @@ -69,48 +51,30 @@ uses UPlatformMacOSX; {$ENDIF} -{ TPlatform } -(* -function TPlatform.GetGamePath: WideString; -begin - // Windows and Linux use this: - Result := ExtractFilePath(ParamStr(0)); -end; -*) -function TPlatform.GetLogPath : WideString; -begin - result := ExtractFilePath(ParamStr(0)); -end; - -function TPlatform.GetGameSharedPath : WideString; -begin - result := ExtractFilePath(ParamStr(0)); -end; +// I have modified it to use the Platform_singleton in this location ( in the implementaiton ) +// so that this variable can NOT be overwritten from anywhere else in the application. +// the accessor function platform, emulates all previous calls to work the same way. +var + Platform_singleton : IPlatform; -function TPlatform.GetGameUserPath : WideString; +function Platform : IPlatform; begin - result := ExtractFilePath(ParamStr(0)); + result := Platform_singleton; end; -function TPlatform.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; -begin - // Linux and Mac don't check for running apps at the moment - Result := false; -end; initialization - {$IFDEF MSWINDOWS} - Platform := TPlatformWindows.Create; + Platform_singleton := TPlatformWindows.Create; {$ENDIF} {$IFDEF LINUX} - Platform := TPlatformLinux.Create; + Platform_singleton := TPlatformLinux.Create; {$ENDIF} {$IFDEF DARWIN} - Platform := TPlatformMacOSX.Create; + Platform_singleton := TPlatformMacOSX.Create; {$ENDIF} finalization - Platform := nil; + Platform_singleton := nil; end. diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 0098baee..cde737b6 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -12,7 +12,7 @@ uses Classes, UPlatform; type - TPlatformLinux = class(TPlatform) + TPlatformLinux = class(TInterfacedObject, IPlatform) function get_homedir(): string; public Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index a418919c..97c32fe3 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -12,13 +12,20 @@ uses Classes, UPlatform; type - TPlatformMacOSX = class(TPlatform) + TPlatformMacOSX = class( TInterfacedObject, IPlatform) private public +<<<<<<< .mine + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; + function GetGamePath: WideString; override; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + procedure halt(); +======= function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; function GetLogPath : WideString; override; function GetGameSharedPath : WideString; override; function GetGameUserPath : WideString; override; +>>>>>>> .r788 end; implementation @@ -100,4 +107,15 @@ begin FPCloseDir(TheDir); end; +function TPlatformMacOSX.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; +begin + result := false; +end; + + +procedure TPlatformMacOSX.halt; +begin + halt; +end; + end. diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index 93e72e7a..d4ba757a 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -8,19 +8,30 @@ interface {$I switches.inc} -uses Classes, UPlatform; +uses Classes, + UPlatform; type - TPlatformWindows = class(TPlatform) + TPlatformWindows = class( TInterfacedObject, IPlatform) public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; override; + 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; +uses SysUtils, + Windows, + Forms; type @@ -175,4 +186,42 @@ begin FindCloseW(SR); end; +function TPlatformWindows.GetGamePath: WideString; +begin + // Windows and Linux use this: + Result := ExtractFilePath(ParamStr(0)); +end; + +procedure TPlatformWindows.halt; +begin + application.terminate; +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/URecord.pas b/Game/Code/Classes/URecord.pas index dee1a687..ab351f6e 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -14,7 +14,9 @@ uses Classes, UCommon, UMusic, UIni; - + +// http://www.poltran.com + type TSound = class BufferNew: TMemoryStream; // buffer for newest sample @@ -26,7 +28,7 @@ type // pitch detection SzczytJest: boolean; // czy jest szczyt - Szczyt: integer; // pozycja szczytu na osi poziomej + pivot : integer; // Position of summit (top) on horizontal pivot TonDokl: real; // ton aktualnego szczytu Ton: integer; // ton bez ulamka TonGamy: integer; // ton w gamie. wartosci: 0-11 @@ -34,8 +36,8 @@ type // procedures procedure ProcessNewBuffer; - procedure AnalizujBufor; // use to analyze sound from buffers to get new pitch - procedure AnalizujByAutocorrelation; // we call it to analyze sound by checking Autocorrelation + procedure AnalyzeBuffer; // use to analyze sound from buffers to get new pitch + procedure AnalyzeByAutocorrelation; // we call it to analyze sound by checking Autocorrelation function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation end; @@ -54,31 +56,46 @@ type CaptureSoundRight: TSound; // sound(-buffer) used for right channel capture data end; - TRecord = class + TAudioInputProcessor = class Sound: array of TSound; SoundCard: array of TGenericSoundCard; + constructor Create; - + // handle microphone input procedure HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; - InputDevice: TGenericSoundCard); + InputDevice: TGenericSoundCard); + + function volume( aChannel : byte ): byte; end; smallintarray = array [0..maxInt shr 1-1] of smallInt; psmallintarray = ^smallintarray; -var - Poz: integer; - Recording: TRecord; + function AudioInputProcessor(): TAudioInputProcessor; implementation uses UMain; +var + singleton_AudioInputProcessor : TAudioInputProcessor = nil; + + // FIXME: Race-Conditions between Callback-thread and main-thread // on BufferArray (maybe BufferNew also). // Use SDL-mutexes to solve this problem. + +function AudioInputProcessor(): TAudioInputProcessor; +begin + if singleton_AudioInputProcessor = nil then + singleton_AudioInputProcessor := TAudioInputProcessor.create(); + + result := singleton_AudioInputProcessor; + +end; + procedure TSound.ProcessNewBuffer; var S: integer; @@ -108,12 +125,12 @@ begin end; end; -procedure TSound.AnalizujBufor; +procedure TSound.AnalyzeBuffer; begin - AnalizujByAutocorrelation; + AnalyzeByAutocorrelation; end; -procedure TSound.AnalizujByAutocorrelation; +procedure TSound.AnalyzeByAutocorrelation; var T: integer; // tone F: real; // freq @@ -143,7 +160,7 @@ begin // analyze all 12 halftones for T := 0 to 35 do // to 11, then 23, now 35 (for Whitney and my high voice) begin - F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81 + F := 130.81 * Power(1.05946309436, T)/2; // let's analyze below 130.81 Wages[T] := AnalyzeAutocorrelationFreq(F); if Wages[T] > MaxW then @@ -164,8 +181,8 @@ begin if MaxV >= Threshold then begin // found acceptable volume // 0.1 SzczytJest := true; - TonGamy := MaxT mod 12; - Ton := MaxT mod 12; + TonGamy := MaxT mod 12; + Ton := MaxT mod 12; end; end; @@ -206,8 +223,7 @@ end; * Length - number of bytes in Buffer * Input - Soundcard-Input used for capture *} -procedure TRecord.HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; - InputDevice: TGenericSoundCard); +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; InputDevice: TGenericSoundCard); var L: integer; S: integer; @@ -231,8 +247,14 @@ begin for S := 0 to L-1 do begin I := PSI^[S] * Boost; - if I > 32767 then I := 32767; // 0.5.0: limit - if I < -32768 then I := -32768; // 0.5.0: limit + + // TODO : JB - This will clip the audio... cant we reduce the "Boot" if the data clips ?? + if I > 32767 then + I := 32767; // 0.5.0: limit + + if I < -32768 then + I := -32768; // 0.5.0: limit + PSI^[S] := I; end; @@ -266,12 +288,13 @@ begin end; end; -constructor TRecord.Create; +constructor TAudioInputProcessor.Create; var S: integer; begin SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do begin //Ini.Players do begin + for S := 0 to High(Sound) do + begin //Ini.Players do begin Sound[S] := TSound.Create; Sound[S].Num := S; Sound[S].BufferNew := TMemoryStream.Create; @@ -281,6 +304,20 @@ begin end; end; +function TAudioInputProcessor.volume( aChannel : byte ): byte; +var + lCount : Integer; + lMaxVol : double; +begin; + lMaxVol := AudioInputProcessor.Sound[aChannel].BufferArray[1]; + for lCount := 2 to AudioInputProcessor.Sound[aChannel].n div 1 do + begin + if AudioInputProcessor.Sound[aChannel].BufferArray[lCount] > lMaxVol then + lMaxVol := AudioInputProcessor.Sound[aChannel].BufferArray[lCount]; + end; + + result := trunc( ( 255 / 32767 ) * trunc( lMaxVol ) ); +end; end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index a4709b43..c5acec9c 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -40,6 +40,7 @@ uses {$IFDEF USE_PSEUDO_THREAD} PseudoThread, {$ENDIF} + USong, UCatCovers; type @@ -55,48 +56,6 @@ type Length: string; end; - TSong = record - Path: widestring; - Folder: widestring; // for sorting by folder - FileName: widestring; - - // sorting methods - Category: array of widestring; // I think I won't need this - Genre: widestring; - Edition: widestring; - Language: widestring; // 0.5.0: new - - Title: widestring; - Artist: widestring; - - Text: widestring; - Creator: widestring; - - Cover: widestring; - CoverTex: TTexture; - Mp3: widestring; - Background: widestring; - Video: widestring; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - end; - {$IFDEF USE_PSEUDO_THREAD} TSongs = class( TPseudoThread ) @@ -104,7 +63,6 @@ type TSongs = class( TThread ) {$ENDIF} private - BrowsePos : Integer; //Actual Pos in Song Array. eddie: Must be int, because it could be decremented to -1. fNotify , fWatch : longint; fParseSongDirectory : boolean; @@ -117,9 +75,13 @@ type protected procedure Execute; override; public - Song : array of TSong; // array of songs +// Song : array of TSong; // array of songs + SongList : TList; // array of songs Selected : integer; // selected song index constructor create(); + destructor destroy(); + + procedure LoadSongList; // load all songs procedure BrowseDir(Dir: widestring); // should return number of songs in the future procedure Sort(Order: integer); @@ -127,6 +89,7 @@ type property Processing : boolean read fProcessing; end; + TCatSongs = class Song: array of TSong; // array of categories with songs Selected: integer; // selected song index @@ -150,7 +113,6 @@ type var Songs: TSongs; // all songs CatSongs: TCatSongs; // categorized songs - AktSong: TSong; // one song *unknown use) const IN_ACCESS = $00000001; //* File was accessed */ @@ -187,6 +149,8 @@ begin inherited create( false ); self.freeonterminate := true; + SongList := TList.create(); + {$ifdef Delphi} fDirWatch := TDirectoryWatch.create(nil); fDirWatch.OnChange := DoDirChanged; @@ -218,12 +182,18 @@ begin writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); *) {$endif} - -{$IFNDEF USE_PSEUDO_THREAD} - Setlength(Song, 0); + +{$IFNDEF USE_PSEUDO_THREAD} +// Setlength(Song, 0); + SongList.clear; {$ENDIF} end; +destructor TSongs.destroy(); +begin + freeandnil( SongList ); +end; + procedure TSongs.DoDirChanged(Sender: TObject); begin LoadSongList(); @@ -237,7 +207,7 @@ begin int_LoadSongList(); {$ELSE} fParseSongDirectory := true; - + while not self.terminated do begin @@ -256,21 +226,15 @@ procedure TSongs.int_LoadSongList; begin try fProcessing := true; - Setlength(Song, 0); + SongList.clear; Log.LogError('SongList', 'Searching For Songs'); - Setlength(Song, 50); - - BrowsePos := 0; // browse directories BrowseDir(SongPath); - + if UserSongPath <> SongPath then BrowseDir(UserSongPath); - - //Set Correct SongArray Length - SetLength(Song, BrowsePos); if assigned( CatSongs ) then CatSongs.Refresh; @@ -287,7 +251,6 @@ begin ScreenSong.OnShow; // refresh ScreenSong end; - finally Log.LogError('SongList', 'Search Complete'); @@ -305,12 +268,13 @@ end; procedure TSongs.BrowseDir(Dir: widestring); var - SLen: integer; - i : Integer; + i : Integer; Files : TDirectoryEntryArray; + lSong : TSong; begin Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + for i := 0 to Length(Files)-1 do begin if Files[i].IsDirectory then @@ -319,37 +283,21 @@ begin end else begin - SLen := BrowsePos; + lSong := TSong.create( Dir + Files[i].Name ); - Song[SLen].Path := Dir; -// Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000); - Song[SLen].Folder := Copy(Dir, Length(Dir)+1, 10000); - Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1); - Song[SLen].FileName := Files[i].Name; - - if (AnalyseFile(Song[SLen]) = false) then + if NOT lSong.Analyse then begin Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - Dec(BrowsePos); + freeandnil( lSong ); end else begin - if Song[SLen].Cover = '' then - Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg'); + SongList.add( lSong ); end; - //Change Length Only every 50 Entrys - Inc(BrowsePos); - - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then - begin - SetLength(Song, Length(Song) + 50); - end; end; end; SetLength( Files, 0); - -// Log.LogStatus('Parsing directory: ' + Dir + SR.Name, 'LoadSongList'); end; procedure TSongs.Sort(Order: integer); @@ -361,91 +309,99 @@ begin case Order of sEdition: // by edition begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Edition, Song[S-1].Edition) < 0 then begin + for S2 := 0 to SongList.Count -1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sGenre: // by genre begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Genre, Song[S-1].Genre) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sTitle: // by title begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sArtist: // by artist begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sFolder: // by folder begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Folder, Song[S-1].Folder) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sTitle2: // by title2 begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Title, Song[S-1].Title) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sArtist2: // by artist2 begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Artist, Song[S-1].Artist) < 0 then begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin // zamiana miejscami - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; sLanguage: // by Language begin - for S2 := 0 to Length(Song)-1 do - for S := 1 to Length(Song)-1 do - if CompareText(Song[S].Language, Song[S-1].Language) < 0 then begin - TempSong := Song[S-1]; - Song[S-1] := Song[S]; - Song[S] := TempSong; + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then + begin + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; end; end; @@ -509,12 +465,13 @@ case Ini.Sorting of //Songs leeren SetLength (Song, 0); - for S := Low(Songs.Song) to High(Songs.Song) do begin + for S := 0 to Songs.SongList.Count-1 do + begin if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, Songs.Song[S].Edition) <> 0) then begin + if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin // add Category Button Inc(Order); - SS := Songs.Song[S].Edition; + SS := TSong( Songs.SongList[S] ).Edition; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + SS + ']'; @@ -554,10 +511,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sGenre) and (CompareText(SS, Songs.Song[S].Genre) <> 0) then begin + else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin // add Genre Button Inc(Order); - SS := Songs.Song[S].Genre; + SS := TSong( Songs.SongList[S] ).Genre; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := SS; @@ -580,10 +537,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sLanguage) and (CompareText(SS, Songs.Song[S].Language) <> 0) then begin + else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin // add Language Button Inc(Order); - SS := Songs.Song[S].Language; + SS := TSong( Songs.SongList[S] ).Language; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := SS; @@ -607,11 +564,11 @@ case Ini.Sorting of end else if (Ini.Sorting = sTitle) and - (Length(Songs.Song[S].Title)>=1) and - (Letter <> UpperCase(Songs.Song[S].Title)[1]) then begin + (Length(TSong( Songs.SongList[S] ).Title)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin // add a letter Category Button Inc(Order); - Letter := Uppercase(Songs.Song[S].Title)[1]; + Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -636,10 +593,11 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sArtist) and (Length(Songs.Song[S].Artist)>=1) and (Letter <> UpperCase(Songs.Song[S].Artist)[1]) then begin + else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin // add a letter Category Button Inc(Order); - Letter := UpperCase(Songs.Song[S].Artist)[1]; + Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; @@ -663,10 +621,10 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sFolder) and (CompareText(SS, Songs.Song[S].Folder) <> 0) then begin + else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin // 0.5.0: add folder tab Inc(Order); - SS := Songs.Song[S].Folder; + SS := TSong( Songs.SongList[S] ).Folder; CatLen := Length(CatSongs.Song); SetLength(CatSongs.Song, CatLen+1); CatSongs.Song[CatLen].Artist := SS; @@ -689,8 +647,8 @@ case Ini.Sorting of CatSongs.Song[CatLen].Visible := true; end - else if (Ini.Sorting = sTitle2) AND (Length(Songs.Song[S].Title)>=1) then begin - if (ord(Songs.Song[S].Title[1]) > 47) and (ord(Songs.Song[S].Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Title)[1]; + else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); @@ -719,8 +677,8 @@ case Ini.Sorting of end; end - else if (Ini.Sorting = sArtist2) AND (Length(Songs.Song[S].Artist)>=1) then begin - if (ord(Songs.Song[S].Artist[1]) > 47) and (ord(Songs.Song[S].Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(Songs.Song[S].Artist)[1]; + else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; if (Letter <> Letter2) then begin // add a letter Category Button Inc(Order); @@ -755,7 +713,7 @@ case Ini.Sorting of Inc (CatNumber); //Increase Number in Cat - CatSongs.Song[CatLen] := Songs.Song[S]; + CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); CatSongs.Song[CatLen].OrderNum := Order; // assigns category CatSongs.Song[CatLen].CatNumber := CatNumber; @@ -923,4 +881,11 @@ begin end; end; + + +// ----------------------------------------------------------------------------- + + + + end. -- cgit v1.2.3 From 19ab8eded9d18e077906fd716ab25992eba1767d Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 12 Jan 2008 12:44:09 +0000 Subject: removed big ugly commented out code.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@790 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 328 +------------------------------------------ 1 file changed, 1 insertion(+), 327 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index d3e4729b..b65dcbf2 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -13,21 +13,9 @@ uses SysUtils, USongs, USong; -//procedure InitializePaths; //Function sets All Absolute Paths eg. for Songs -//function ReadTXTHeader(var Song: TSong): boolean; //Reads Standard TXT Header -//function AnalyseFile(var Song: TSong): boolean; //Analyse Song File and Read Header -//procedure ClearSong(var Song: TSong); //Clears Song Header values - -//Methodes Loading and Saving Songfiles procedure ResetSingTemp; -//procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -//procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); - -//function LoadSong(Name: string): boolean; function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean; - - var SongFile: TextFile; // all procedures in this unit operates on this file FileLineNo: integer; //Line which is readed at Last, for error reporting @@ -44,321 +32,7 @@ uses TextGL, UIni, UPlatform, UMain; - -(* -//-------------------- -<<<<<<< .mine -======= -// Clears Song Header values -//-------------------- -procedure ClearSong(var Song: TSong); -begin - //Main Information - Song.Title := ''; - Song.Artist := ''; - - //Sortings: - Song.Genre := 'Unknown'; - Song.Edition := 'Unknown'; - Song.Language := 'Unknown'; //Language Patch - - //Required Information - Song.Mp3 := ''; - {$IFDEF FPC} - setlength( Song.BPM, 0 ); - {$ELSE} - Song.BPM := 0; - {$ENDIF} - - Song.GAP := 0; - Song.Start := 0; - Song.Finish := 0; - - //Additional Information - Song.Background := ''; - Song.Cover := ''; - Song.Video := ''; - Song.VideoGAP := 0; - Song.NotesGAP := 0; - Song.Resolution := 4; - Song.Creator := ''; -end; - -//-------------------- -// Reads Standard TXT Header -//-------------------- -function ReadTXTHeader(var Song: TSong): boolean; -var - Line, Identifier, Value: String; - Temp: word; - Done: byte; -begin - Result := true; - Done := 0; - - //Read first Line - ReadLn (SongFile, Line); - - if (Length(Line)<=0) then - begin - Log.LogError('File Starts with Empty Line: ' + Song.FileName); - Result := False; - Exit; - end; - - //Read Lines while Line starts with # - While (Length(Line) = 0) OR (Line[1] = '#') do - begin - //Increase Line Number - Inc (FileLineNo); - Temp := Pos(':', Line); - - //Line has a Seperator-> Headerline - if (Temp <> 0) then - begin - //Read Identifier and Value - Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks - Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); - - //Check the Identifier (If Value is given) - if (Length(Value) <> 0) then - begin - - {$IFDEF DARWIN} - if ((Identifier = 'MP3') or (Identifier = 'COVER') or (Identifier = 'BACKGROUND') or (Identifier = 'VIDEO')) then - begin - // Filenames on OS X must be UTF8: - Value := Utf8Encode(Value); - end; - {$ENDIF} - - - //----------- - //Required Attributes - //----------- - - //Title - if (Identifier = 'TITLE') then - begin - Song.Title := Value; - - //Add Title Flag to Done - Done := Done or 1; - end - - //Artist - else if (Identifier = 'ARTIST') then - begin - Song.Artist := Value; - - //Add Artist Flag to Done - Done := Done or 2; - end - - //MP3 File //Test if Exists - else if (Identifier = 'MP3') AND (FileExists(Song.Path + Value)) then - begin - Song.Mp3 := Value; - - //Add Mp3 Flag to Done - Done := Done or 4; - end - - //Beats per Minute - else if (Identifier = 'BPM') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - SetLength(Song.BPM, 1); - Song.BPM[0].StartBeat := 0; - - Song.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; - - if Song.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end - - //--------- - //Additional Header Information - //--------- - - // Video Gap - else if (Identifier = 'GAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.GAP := StrtoFloatDef (Value, 0); - end - - //Cover Picture - else if (Identifier = 'COVER') then - begin - Song.Cover := Value; - end - - //Background Picture - else if (Identifier = 'BACKGROUND') then - begin - Song.Background := Value; - end - - // Video File - else if (Identifier = 'VIDEO') then - begin - if (FileExists(Song.Path + Value)) then - Song.Video := Value - else - Log.LogError('Can''t find Video File in Song: ' + Song.Path + Song.FileName); - end - - // Video Gap - else if (Identifier = 'VIDEOGAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.VideoGAP := StrtoFloatDef (Value, 0); - end - - //Genre Sorting - else if (Identifier = 'GENRE') then - begin - Song.Genre := Value; - end - - //Edition Sorting - else if (Identifier = 'EDITION') then - begin - Song.Edition := Value; - end - - //Creator Tag - else if (Identifier = 'CREATOR') then - begin - Song.Creator := Value; - end - - //Language Sorting - else if (Identifier = 'LANGUAGE') then - begin - Song.Language := Value; - end - - // Song Start - else if (Identifier = 'START') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - Song.Start := StrtoFloatDef(Value, 0); - end - - // Song Ending - else if (Identifier = 'END') then - begin - TryStrtoInt(Value, Song.Finish); - end - - // Resolution - else if (Identifier = 'RESOLUTION') then - begin - TryStrtoInt(Value, Song.Resolution); - end - - // Notes Gap - else if (Identifier = 'NOTESGAP') then - begin - TryStrtoInt(Value, Song.NotesGAP); - end - - // Relative Notes - else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then - begin - Song.Relative := True; - end; - - end; - end; - - if not EOf(SongFile) then - ReadLn (SongFile, Line) - else - begin - Result := False; - Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + Song.FileName); - break; - end; - - {//End on first empty Line - if (Length(Line) = 0) then - break;} - end; - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := False; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + Song.FileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + Song.FileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + Song.FileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + Song.FileName) - else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + Song.FileName); - end; - -end; - -//-------------------- -// Analyse Song File and Read Header -//-------------------- -function AnalyseFile(var Song: TSong): boolean; -begin -Result := False; -{try } - //Reset LineNo - FileLineNo := 0; - - //Open File and set File Pointer to the beginning - AssignFile(SongFile, Song.Path + Song.FileName); - -// if assinged( SongFile ) then - begin - try - Reset(SongFile); - - //Clear old Song Header - ClearSong(Song); - - //Read Header - Result := ReadTxTHeader(Song); - - //And Close File - finally - CloseFile(SongFile); - end; - end; -{except - CloseFile(SongFile); - - Result := False; - //Error Reporting - Log.LogError('An Error occured reading Line ' + inttostr(FileLineNo) + ' from SongHeader: ' + Song.FileName); -end;} -end; - *) + //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables //-------------------- -- cgit v1.2.3 From ceae3d4f3b8d1697ec345787b35064f96fc67e14 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 12 Jan 2008 12:49:16 +0000 Subject: oops... :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@791 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformMacOSX.pas | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index 97c32fe3..30a2ab47 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -15,17 +15,13 @@ type TPlatformMacOSX = class( TInterfacedObject, IPlatform) private public -<<<<<<< .mine Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; function GetGamePath: WideString; override; function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; procedure halt(); -======= - function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - function GetLogPath : WideString; override; - function GetGameSharedPath : WideString; override; - function GetGameUserPath : WideString; override; ->>>>>>> .r788 + function GetLogPath : WideString; override; + function GetGameSharedPath : WideString; override; + function GetGameUserPath : WideString; override; end; implementation @@ -52,6 +48,7 @@ end; function TPlatformMacOSX.GetLogPath : WideString; begin + // surly logs go in /var/log/ ??? Result := GetBundlePath; end; @@ -62,6 +59,8 @@ end; function TPlatformMacOSX.GetGameUserPath : WideString; begin + // is there no user profile ??? + // like ... /home/user/ that could be used for song locations etc ?? Result := GetBundlePath; end; -- cgit v1.2.3 From 8226572159609fc0ee15de155d84576c00163371 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sun, 13 Jan 2008 12:48:28 +0000 Subject: oops sorry I forgot this one .. bugger ! git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@792 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USong.pas | 706 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 706 insertions(+) create mode 100644 Game/Code/Classes/USong.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas new file mode 100644 index 00000000..6af16a1a --- /dev/null +++ b/Game/Code/Classes/USong.pas @@ -0,0 +1,706 @@ +unit USong; + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ifdef Delphi} + DirWatch, + {$endif} + {$ELSE} + {$IFNDEF DARWIN} +// oldlinux, + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + UCatCovers; + +type + + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + TSong = class + + FileLineNo : integer; //Line which is readed at Last, for error reporting + + procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); + + function ReadTXTHeader( const aFileName : WideString ): boolean; + public + + Path: widestring; + Folder: widestring; // for sorting by folder + fFileName, + FileName: widestring; + + // sorting methods + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new + + Title: widestring; + Artist: widestring; + + Text: widestring; + Creator: widestring; + + Cover: widestring; + CoverTex: TTexture; + Mp3: widestring; + Background: widestring; + Video: widestring; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + + SongFile: TextFile; // all procedures in this unit operates on this file + + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer; + MultBPM : integer; + + constructor create ( const aFileName : WideString ); + function LoadSong: boolean; + function Analyse(): boolean; + procedure clear(); + end; + +implementation + +uses + TextGL, + UIni, + UMusic, // needed for Czesci .. ( whatever that is ) + UMain; //needed for Player + +constructor TSong.create( const aFileName : WideString ); +begin + Mult := 1; + MultBPM := 4; + + fFileName := aFileName; + + if fileexists( aFileName ) then + begin + self.Path := ExtractFilePath( aFileName ); + self.Folder := ExtractFilePath( aFileName ); + self.FileName := ExtractFileName( aFileName ); + + (* + if ReadTXTHeader( aFileName ) then + begin + LoadSong(); + end + else + begin + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; +*) + end; + +end; + + function TSong.LoadSong(): boolean; + var + TempC: char; + Tekst: string; + CP: integer; // Current Player (0 or 1) + Pet: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Path + PathDelim + FileName) then + begin + Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'WczytajCzesci'); + exit; + end; + + try + MultBPM := 4; // 4 - mnoznik dla czasu nut + Mult := 1; // 4 - dokladnosc pomiaru nut + Base[0] := 100; // high number + Czesci[0].Wartosc := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + // Open song file for reading..... + FileMode := fmOpenRead; + AssignFile(SongFile, fFileName); + Reset(SongFile); + + //Clear old Song Header + if (self.Path = '') then + self.Path := ExtractFilePath(FileName); + + if (self.FileName = '') then + self.Filename := ExtractFileName(FileName); + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Tekst); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + CloseFile(SongFile); + Log.LogError('Could not load txt File, no Notes found: ' + FileName); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Czesci, 2); + for Pet := 0 to High(Czesci) do begin + SetLength(Czesci[Pet].Czesc, 1); + Czesci[Pet].High := 0; + Czesci[Pet].Ilosc := 1; + Czesci[Pet].Akt := 0; + Czesci[Pet].Resolution := self.Resolution; + Czesci[Pet].NotesGAP := self.NotesGAP; + Czesci[Pet].Czesc[0].IlNut := 0; + Czesci[Pet].Czesc[0].HighNut := -1; + end; + + // TempC := ':'; + // TempC := Tekst[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do + begin + + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // wczytuje nute + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + // dodaje nute + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; // if + + if TempC = '-' then + begin + // reads sentence + Read(SongFile, Param1); + if self.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + end; // if + + if TempC = 'B' then + begin + SetLength(self.BPM, Length(self.BPM) + 1); + Read(SongFile, self.BPM[High(self.BPM)].StartBeat); + self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Tekst); + self.BPM[High(self.BPM)].BPM := StrToFloat(Tekst); + self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then + begin + Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; + Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); + //Total Notes Patch + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; + for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do + begin + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end else begin + for Pet := 0 to High(Czesci) do begin + Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; + Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); + //Total Notes Patch + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; + for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do + begin + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end; + end; + + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + + function TSong.ReadTXTHeader(const aFileName : WideString): boolean; + var + Line, Identifier, Value: String; + Temp : word; + Done : byte; +begin + Result := true; + Done := 0; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + aFileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # or its empty + While ( Length(Line) = 0 ) OR + ( Line[1] = '#' ) DO + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + //Title + if (Identifier = 'TITLE') then + begin + self.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + self.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND + (FileExists(self.Path + Value)) then + begin + self.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + // Video Gap + else if (Identifier = 'GAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.GAP := StrtoFloatDef (Value, 0); + end + + //Cover Picture + else if (Identifier = 'COVER') then + self.Cover := Value + + //Background Picture + else if (Identifier = 'BACKGROUND') then + self.Background := Value + + // Video File + else if (Identifier = 'VIDEO') then + begin + if (FileExists(self.Path + Value)) then + self.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + aFileName); + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.VideoGAP := StrtoFloatDef (Value, 0); + end + + //Genre Sorting + else if (Identifier = 'GENRE') then + self.Genre := Value + + //Edition Sorting + else if (Identifier = 'EDITION') then + self.Edition := Value + + //Creator Tag + else if (Identifier = 'CREATOR') then + self.Creator := Value + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + self.Language := Value + + // Song Start + else if (Identifier = 'START') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.Start := StrtoFloatDef(Value, 0); + end + + // Song Ending + else if (Identifier = 'END') then + TryStrtoInt(Value, self.Finish) + + // Resolution + else if (Identifier = 'RESOLUTION') then + TryStrtoInt(Value, self.Resolution) + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + TryStrtoInt(Value, self.NotesGAP) + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + self.Relative := True; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); + break; + end; + + end; + + if self.Cover = '' then + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + self.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + self.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + self.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +end; + +procedure TSong.ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +var + Space: boolean; +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin + SetLength(Nuta, Length(Nuta) + 1); + IlNut := IlNut + 1; + HighNut := HighNut + 1; + Muzyka.IlNut := Muzyka.IlNut + 1; + + Nuta[HighNut].Start := StartP; + if IlNut = 1 then begin + StartNote := Nuta[HighNut].Start; + if Czesci[NrCzesci].Ilosc = 1 then + Start := -100; +// Start := Nuta[HighNut].Start; + end; + + Nuta[HighNut].Dlugosc := DurationP; + Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Nuta[HighNut].Wartosc := 0; + ':': Nuta[HighNut].Wartosc := 1; + '*': Nuta[HighNut].Wartosc := 2; + end; + + Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; + + Nuta[HighNut].Ton := NoteP; + if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; + Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; + + Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); + Lyric := Lyric + Nuta[HighNut].Tekst; + + if TypeP = 'F' then + Nuta[HighNut].FreeStyle := true; + + Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; + end; // with +end; + +procedure TSong.NewSentence(NrCzesciP: integer; Param1, Param2: integer); +var +I: Integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); + + //Total Notes Patch + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; + for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); + Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; + Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; + + if self.Relative then + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; + end + else + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + + Base[NrCzesciP] := 100; // high number +end; + +procedure TSong.clear(); +begin + //Main Information + Title := ''; + Artist := ''; + + //Sortings: + Genre := 'Unknown'; + Edition := 'Unknown'; + Language := 'Unknown'; //Language Patch + + //Required Information + Mp3 := ''; + {$IFDEF FPC} + setlength( BPM, 0 ); + {$ELSE} + BPM := 0; + {$ENDIF} + + GAP := 0; + Start := 0; + Finish := 0; + + //Additional Information + Background := ''; + Cover := ''; + Video := ''; + VideoGAP := 0; + NotesGAP := 0; + Resolution := 4; + Creator := ''; + +end; + +function TSong.Analyse(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, self.Path + self.FileName); + + try + Reset(SongFile); + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadTxTHeader( FileName ) + + //And Close File + finally + CloseFile(SongFile); + end; +end; + + + +end. -- cgit v1.2.3 From 1b458d8b1f4723ce82bb74f2157982980274e79c Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 14 Jan 2008 12:27:38 +0000 Subject: tidy up sing mode, to be an enum now. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@794 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlaylist.pas | 7 +++++-- Game/Code/Classes/USong.pas | 2 ++ 2 files changed, 7 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index 8d981065..2c09c493 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -9,6 +9,9 @@ interface {$I switches.inc} +uses + USong; + type TPlaylistItem = record Artist: String; @@ -33,7 +36,7 @@ type private public - Mode: Byte; //Current Playlist Mode for SongScreen + Mode: TSingMode; //Current Playlist Mode for SongScreen CurPlayList: Cardinal; CurItem: Cardinal; @@ -262,7 +265,7 @@ begin //Set CatSongsMode + Playlist Mode CatSongs.CatNumShow := -3; - Mode := 2; + Mode := smPlayListRandom; //Set CurPlaylist CurPlaylist := Index; diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas index 6af16a1a..728f5055 100644 --- a/Game/Code/Classes/USong.pas +++ b/Game/Code/Classes/USong.pas @@ -33,6 +33,8 @@ uses type + TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); + TBPM = record BPM: real; StartBeat: real; -- cgit v1.2.3 From e95f320dd030e9def8174e8b173e3631f11dba25 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 18 Jan 2008 16:30:06 +0000 Subject: added blindy's swscale support. It can be enabled with {$DEFINE UseSWScale}. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@795 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index bbd03d84..c30b271e 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -37,6 +37,9 @@ uses SDL, avcodec, avformat, avutil, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} math, OpenGL12, SysUtils, @@ -77,6 +80,10 @@ type AVFrameRGB: PAVFrame; myBuffer: pByte; + {$IFDEF UseSWScale} + SoftwareScaleContext: PSwsContext; + {$ENDIF} + TexX, TexY, dataX, dataY: Cardinal; ScaledVideoWidth, ScaledVideoHeight: Real; @@ -312,10 +319,18 @@ begin if Framefinished=0 then begin 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), PIX_FMT_RGB24, PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, VideoCodecContext^.width, VideoCodecContext^.height); + {$ENDIF} + if errnum >=0 then begin glBindTexture(GL_TEXTURE_2D, fVideoTex); @@ -568,6 +583,23 @@ begin av_close_input_file(VideoFormatContext); Exit; end; + + {$IFDEF UseSWScale} + SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), + dataX, dataY, integer(PIX_FMT_RGB24), + SWS_FAST_BILINEAR, 0, 0, 0); + if SoftwareScaleContext <> Nil then + writeln('got swscale context') + else begin + writeln('ERROR: didn´t get swscale context'); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + {$ENDIF} + // this is the errnum from avpicture_fill if errnum >=0 then begin -- cgit v1.2.3 From fc31e84fe89000bee337983d933539794c7552fd Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sun, 20 Jan 2008 16:27:17 +0000 Subject: Fixed compilation on the mac. At the moment the project doesn't link on the mac. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@798 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformMacOSX.pas | 48 +++++++++++++++++++++++++---------- 1 file changed, 35 insertions(+), 13 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas index 30a2ab47..7b081607 100644 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -1,5 +1,18 @@ unit UPlatformMacOSX; +// Note on directories (by eddie): +// We use subfolders of the application directory on tha mac, because: +// 1. Installation on the mac works as follows: Extract and copy an application +// and if you don't like or need the application anymore you move the folder +// to the trash - and you're done. +// 2. If we would use subfolders of the home directory we would have to spread our +// files to many directories - these directories are defined by Apple, but the +// average user doesn't know them, beacuse he or she doesn't need to know them. +// But for UltraStar the user must at least know the songs directory... +// +// Creating a subfolder directly under the home directory is not acceptable. +// + interface {$IFDEF FPC} @@ -13,15 +26,14 @@ uses Classes, UPlatform; type TPlatformMacOSX = class( TInterfacedObject, IPlatform) - private public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - function GetGamePath: WideString; override; + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; procedure halt(); - function GetLogPath : WideString; override; - function GetGameSharedPath : WideString; override; - function GetGameUserPath : WideString; override; + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + function FindSongFile(Dir, Mask: widestring): widestring; end; implementation @@ -48,19 +60,19 @@ end; function TPlatformMacOSX.GetLogPath : WideString; begin - // surly logs go in /var/log/ ??? - Result := GetBundlePath; + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. + Result := GetBundlePath + '/Logs'; end; function TPlatformMacOSX.GetGameSharedPath : WideString; begin + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. Result := GetBundlePath; end; function TPlatformMacOSX.GetGameUserPath : WideString; begin - // is there no user profile ??? - // like ... /home/user/ that could be used for song locations etc ?? + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. Result := GetBundlePath; end; @@ -69,8 +81,6 @@ var i : Integer; TheDir : pdir; ADirent : pDirent; - Entry : Longint; - info : stat; lAttrib : integer; begin i := 0; @@ -108,7 +118,7 @@ end; function TPlatformMacOSX.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; begin - result := false; + result := false; end; @@ -117,4 +127,16 @@ begin halt; end; +function TPlatformMacOSX.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. -- cgit v1.2.3 From fb4154e323aeb2cb3c601a418bd5362253b62134 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sun, 20 Jan 2008 18:15:00 +0000 Subject: Fixed song loading on OS X (UTF8 filenames). Added switches.inc. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@800 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USong.pas | 107 +++++++++++++++++++++++++++----------------- 1 file changed, 66 insertions(+), 41 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas index 728f5055..e5777c75 100644 --- a/Game/Code/Classes/USong.pas +++ b/Game/Code/Classes/USong.pas @@ -1,9 +1,15 @@ -unit USong; - -interface - -uses - {$IFDEF MSWINDOWS} +unit USong; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} Windows, {$ifdef Delphi} DirWatch, @@ -29,8 +35,8 @@ uses PseudoThread, {$ENDIF} UCatCovers; - -type + +type TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); @@ -109,33 +115,43 @@ type function Analyse(): boolean; procedure clear(); end; - -implementation - -uses - TextGL, - UIni, - UMusic, // needed for Czesci .. ( whatever that is ) - UMain; //needed for Player - -constructor TSong.create( const aFileName : WideString ); + +implementation + +uses + TextGL, + UIni, + UMusic, // needed for Czesci .. ( whatever that is ) + UMain; //needed for Player + +constructor TSong.create( const aFileName : WideString ); begin - Mult := 1; - MultBPM := 4; - - fFileName := aFileName; - - if fileexists( aFileName ) then - begin - self.Path := ExtractFilePath( aFileName ); - self.Folder := ExtractFilePath( aFileName ); + + Mult := 1; + + MultBPM := 4; + + + fFileName := aFileName; + + + if fileexists( aFileName ) then + + begin + + self.Path := ExtractFilePath( aFileName ); + self.Folder := ExtractFilePath( aFileName ); self.FileName := ExtractFileName( aFileName ); - (* - if ReadTXTHeader( aFileName ) then - begin - LoadSong(); - end +(* + + if ReadTXTHeader( aFileName ) then + + begin + + LoadSong(); + + end else begin Log.LogError('Error Loading SongHeader, abort Song Loading'); @@ -145,9 +161,11 @@ begin end; end; - - function TSong.LoadSong(): boolean; - var + + +function TSong.LoadSong(): boolean; + +var TempC: char; Tekst: string; CP: integer; // Current Player (0 or 1) @@ -319,9 +337,11 @@ begin Result := true; end; - - function TSong.ReadTXTHeader(const aFileName : WideString): boolean; - var + + +function TSong.ReadTXTHeader(const aFileName : WideString): boolean; + +var Line, Identifier, Value: String; Temp : word; Done : byte; @@ -362,6 +382,11 @@ begin //Required Attributes //----------- + {$IFDEF UTF8_FILENAMES} + if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then + Value := Utf8Encode(Value); + {$ENDIF} + //Title if (Identifier = 'TITLE') then begin @@ -646,7 +671,7 @@ end; procedure TSong.clear(); begin - //Main Information + //Main Information Title := ''; Artist := ''; @@ -675,7 +700,7 @@ begin NotesGAP := 0; Resolution := 4; Creator := ''; - + end; function TSong.Analyse(): boolean; @@ -705,4 +730,4 @@ end; -end. +end. -- cgit v1.2.3 From 8a73bd2301655e736bc307aad3c807f4b5310903 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sun, 20 Jan 2008 18:17:19 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@802 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index c5acec9c..2bf98151 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -149,7 +149,9 @@ begin inherited create( false ); self.freeonterminate := true; - SongList := TList.create(); + // This check is needed if PseudoThread is used: + if not Assigned(SongList) then + SongList := TList.create(); {$ifdef Delphi} fDirWatch := TDirectoryWatch.create(nil); @@ -191,8 +193,8 @@ end; destructor TSongs.destroy(); begin - freeandnil( SongList ); -end; + freeandnil( SongList ); +end; procedure TSongs.DoDirChanged(Sender: TObject); begin @@ -227,7 +229,11 @@ begin try fProcessing := true; - SongList.clear; + {$IFDEF USE_PSEUDO_THREAD} + if not Assigned(SongList) then + SongList := TList.create(); + {$ENDIF} + SongList.clear; Log.LogError('SongList', 'Searching For Songs'); // browse directories -- cgit v1.2.3 From 8c8037702011cbcc7f1bdc420ea1430025c573e0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 25 Jan 2008 16:49:18 +0000 Subject: reenabled TLog.LogError(Log1, Log2: string). Some severe errors have not been displayed because this function was disabled. If this function should be deprecated then mark it as deprecated instead of just emptying the body of the function. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@803 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 49b02c00..c9c87a92 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -234,7 +234,7 @@ end; procedure TLog.LogError(Log1, Log2: string); begin -//asd + LogError(Log1 + ' ['+Log2+']'); end; procedure TLog.CriticalError(Text: string); -- cgit v1.2.3 From 7870ce72a56d56736550376a15e3469fed3afd5d Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 25 Jan 2008 17:03:38 +0000 Subject: Bugfix: some inherited functions were missing. Jay please check for correctness (did you forget to check your file in?)! git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@804 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 39 ++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index cde737b6..2115428f 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -15,12 +15,15 @@ type TPlatformLinux = class(TInterfacedObject, IPlatform) function get_homedir(): string; public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; override; - function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; override; - - function GetLogPath : WideString; override; - function GetGameSharedPath : WideString; override; - function GetGameUserPath : WideString; override; + function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + function FindSongFile(Dir, Mask: widestring): widestring; + + procedure Halt; + + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; end; implementation @@ -155,10 +158,34 @@ begin result := pPasswdEntry^.pw_dir; end; +// FIXME: just a dirty-fix to make the linux build work again. +// This i the same as the corresponding function for windows +// and MacOSX. +// Maybe this should be TPlatformBase.Halt() +procedure TPlatformLinux.Halt; +begin + application.terminate; +end; + function TPlatformLinux.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; begin // Linux and Mac don't check for running apps at the moment Result := false; end; +// FIXME: just a dirty-fix to make the linux build work again. +// This i the same as the corresponding function for windows +// (and MacOSX?). +// Maybe this should be TPlatformBase.FindSongFile() +function TPlatformLinux.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. -- cgit v1.2.3 From d97013cb176bdda64e85db47d8e61a50e7e8bfb7 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 27 Jan 2008 10:05:34 +0000 Subject: - Added missing "override" for TSongs.destroy(). - Bugfix: Fixed a severe Race-Condition that crashed USDX on startup from time to time. The race-condition was due to unsuspended thread-creation in the constructor TSongs.create(). If a class is inherited from TThread and calls "inherited create(false)" in its constructor the thread will immediately start its Execute() method, although the overridden constructor is not finished yet and the members may not be initialized (in this case a TList has not been created). NOTE: If you inherit from TThread always create the thread in suspended mode ("inherited create(true)") and call "Resume()" at the end of the constructor. Don't do this if the class is subject to be overriden, otherwise you may get a race-condition in the child-classes then. In this case it would be better if Resume() was called by the creator of the object. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@805 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 1785 +++++++++++++++++++++--------------------- 1 file changed, 888 insertions(+), 897 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 2bf98151..53d5556f 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,897 +1,888 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF DARWIN} - {$IFDEF DEBUG} - {$DEFINE USE_PSEUDO_THREAD} - {$ENDIF} -{$ENDIF} - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ifdef Delphi} - DirWatch, - {$endif} - {$ELSE} - {$IFNDEF DARWIN} -// oldlinux, - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - USong, - UCatCovers; - -type - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - - {$IFDEF USE_PSEUDO_THREAD} - TSongs = class( TPseudoThread ) - {$ELSE} - TSongs = class( TThread ) - {$ENDIF} - private - fNotify , - fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; - {$ifdef Delphi} - fDirWatch : TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public -// Song : array of TSong; // array of songs - SongList : TList; // array of songs - Selected : integer; // selected song index - constructor create(); - destructor destroy(); - - - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; - end; - - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; - -{$IFDEF DARWIN} -function AnsiContainsText(const AText, ASubText: string): Boolean; -begin - Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; -end; -{$ENDIF} - -constructor TSongs.create(); -begin - inherited create( false ); - self.freeonterminate := true; - - // This check is needed if PseudoThread is used: - if not Assigned(SongList) then - SongList := TList.create(); - - {$ifdef Delphi} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - {$IFDEF linux} - (* - Thankyou to : http://www.linuxjournal.com/article/8478 - http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch - *) -(* - fNotify := -1; - fWatch := -1; - - writeln( 'Calling inotify_init' ); - fNotify := Do_SysCall( syscall_nr_inotify_init ); - if ( fNotify < 0 ) then - writeln( 'Filesystem change notification - disabled' ); - writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); - - writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); - fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); - - if (fWatch < 0) then - writeln ('inotify_add_watch'); - writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); -*) - {$endif} - -{$IFNDEF USE_PSEUDO_THREAD} -// Setlength(Song, 0); - SongList.clear; -{$ENDIF} -end; - -destructor TSongs.destroy(); -begin - freeandnil( SongList ); -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify : THandle; -begin -{$IFDEF USE_PSEUDO_THREAD} - int_LoadSongList(); -{$ELSE} - fParseSongDirectory := true; - - while not self.terminated do - begin - - if fParseSongDirectory then - begin - writeln( 'int_LoadSongList' ); - int_LoadSongList(); - end; - - self.suspend; - end; -{$ENDIF} -end; - -procedure TSongs.int_LoadSongList; -begin - try - fProcessing := true; - - {$IFDEF USE_PSEUDO_THREAD} - if not Assigned(SongList) then - SongList := TList.create(); - {$ENDIF} - SongList.clear; - Log.LogError('SongList', 'Searching For Songs'); - - // browse directories - BrowseDir(SongPath); - - if UserSongPath <> SongPath then - BrowseDir(UserSongPath); - - if assigned( CatSongs ) then - CatSongs.Refresh; - - if assigned( CatCovers ) then - CatCovers.Load; - - if assigned( Covers ) then - Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - finally - Log.LogError('SongList', 'Search Complete'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - self.resume; -end; - -procedure TSongs.BrowseDir(Dir: widestring); -var - i : Integer; - Files : TDirectoryEntryArray; - lSong : TSong; -begin - - Files := Platform.DirectoryFindFiles( Dir, '.txt', true); - - for i := 0 to Length(Files)-1 do - begin - if Files[i].IsDirectory then - begin - BrowseDir( Dir + Files[i].Name + PathDelim ); - end - else - begin - lSong := TSong.create( Dir + Files[i].Name ); - - if NOT lSong.Analyse then - begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); - end - else - begin - SongList.add( lSong ); - end; - - end; - end; - SetLength( Files, 0); -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to SongList.Count -1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then - begin - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := 0 to Songs.SongList.Count-1 do - begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and - (Length(TSong( Songs.SongList[S] ).Title)>=1) and - (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and - (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := TSong( Songs.SongList[S] ).Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin - if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin - if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - - - -// ----------------------------------------------------------------------------- - - - - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF DARWIN} + {$IFDEF DEBUG} + {$DEFINE USE_PSEUDO_THREAD} + {$ENDIF} +{$ENDIF} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$IFDEF Delphi} + DirWatch, + {$ENDIF} + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + USong, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + + {$IFDEF USE_PSEUDO_THREAD} + TSongs = class( TPseudoThread ) + {$ELSE} + TSongs = class( TThread ) + {$ENDIF} + private + fNotify , + fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef Delphi} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public +// Song : array of TSong; // array of songs + SongList : TList; // array of songs + Selected : integer; // selected song index + constructor create(); + destructor destroy(); override; + + + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} + +constructor TSongs.create(); +begin + // do not start thread BEFORE initialization (suspended = true) + inherited create( true ); + self.freeonterminate := true; + + SongList := TList.create(); + + {$ifdef Delphi} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + // now we can start the thread + Resume(); +end; + +destructor TSongs.destroy(); +begin + freeandnil( SongList ); +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin +{$IFDEF USE_PSEUDO_THREAD} + int_LoadSongList(); +{$ELSE} + fParseSongDirectory := true; + + while not self.terminated do + begin + + if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; +{$ENDIF} +end; + +procedure TSongs.int_LoadSongList; +begin + try + fProcessing := true; + + Log.LogError('SongList', 'Searching For Songs'); + + // browse directories + BrowseDir(SongPath); + + if UserSongPath <> SongPath then + BrowseDir(UserSongPath); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + if assigned( Covers ) then + Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + finally + Log.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; +end; + +procedure TSongs.BrowseDir(Dir: widestring); +var + i : Integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseDir( Dir + Files[i].Name + PathDelim ); + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if NOT lSong.Analyse then + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end + else + begin + SongList.add( lSong ); + end; + + end; + end; + SetLength( Files, 0); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to SongList.Count -1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then + begin + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := 0 to Songs.SongList.Count-1 do + begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and + (Length(TSong( Songs.SongList[S] ).Title)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := TSong( Songs.SongList[S] ).Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + + + +// ----------------------------------------------------------------------------- + + + + +end. -- cgit v1.2.3 From 1e473d07c13c60a49a590e46314eb653c15b15e9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 27 Jan 2008 10:16:40 +0000 Subject: Bugfix: In glTextWidth() "text := pchar(Copy(text, 2, Length(text)-1))" does not work with FPC, probably because a part of text is assigned to itself. Note: Why is the string copied so many times just to get the current character? I just simplified this method to use Text[index] instead. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@806 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 1121 +++++++++++++++++++++--------------------- 1 file changed, 562 insertions(+), 559 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index ed897071..0bd61fa7 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,559 +1,562 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses OpenGL12, - SDL, - UTexture, - Classes, - dialogs, - 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); - -// 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; - 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; - -implementation - -uses UMain, - UCommon, - {$IFDEF win32} - windows, - {$ELSE} - lclintf, - lcltype, - {$ENDIF} - SysUtils, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - UGraphic; - -procedure BuildFont; // Build Our Bitmap Font - - procedure loadfont( aID : integer; aType, aResourceName : String); - {$IFDEF LAZARUS} - var - lLazRes : TLResource; - lResData : TStringStream; - begin - try - lLazRes := LazFindResource( aResourceName, aType ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - lResData.Read(Fonts[ aID ].Width, 256); - finally - freeandnil( lResData ); - end; - end; - - {$ELSE} - var - Rejestr: TResourceStream; - begin - try - Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); - try - Rejestr.Read(Fonts[ aID ].Width, 256); - finally - Rejestr.Free; - end; - {$ENDIF} - - except - Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); - end; - end; - -var - font: HFONT; // Windows Font ID - h_dc: hdc; - Pet: integer; -begin - ActFont := 0; - - Log.LogStatus( '' , '---------------------------'); - - Log.LogStatus( 'Font' , '---------------------------'); - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', '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', 'PNG', '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', 'PNG', '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', 'PNG', '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', 'BMP', 'Arrow', 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - - - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - -{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Rejestr.Read(Fonts[4].Width, 256); - Rejestr.Free;} - - for Pet := 0 to 255 do - Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; - - for Pet := 0 to 255 do - Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; - - for Pet := 0 to 255 do - Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; - -{ for Pet := 0 to 255 do - Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} - -end; - -procedure KillFont; // Delete The Font -begin -// glDeleteLists(base, 256); // Delete All 96 Characters -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; -begin -// Log.LogStatus(Text, 'glTextWidth'); - Result := 0; - while (length(text) > 0) do begin - Letter := Text[0]; - text := pchar(Copy(text, 2, Length(text)-1)); - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; // while -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; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter -begin - with Fonts[ActFont].Tex do - begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; - // H := 30; - - // 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; - - // 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; - - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with -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; - -procedure glPrint(text: pchar); // Custom GL "Print" Routine -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 -*) - - // 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; - -function NextPowerOfTwo(Value: Integer): Integer; -// tyty to Asphyre -begin - Result:= 1; - asm - xor ecx, ecx - bsr ecx, Value - inc ecx - shl Result, cl - end; -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 ); - 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, 0, intermediary, 0); - - 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; - - -{$IFDEF LAZARUS} -{$IFDEF win32} -initialization - {$I UltraStar.lrs} -{$ENDIF} -{$ENDIF} - - -end. - - +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses OpenGL12, + SDL, + UTexture, + Classes, + dialogs, + 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); + +// 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; + 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; + +implementation + +uses UMain, + UCommon, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + lcltype, + {$ENDIF} + SysUtils, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + UGraphic; + +procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont( aID : integer; aType, aResourceName : String); + {$IFDEF LAZARUS} + var + lLazRes : TLResource; + lResData : TStringStream; + begin + try + lLazRes := LazFindResource( aResourceName, aType ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + lResData.Read(Fonts[ aID ].Width, 256); + finally + freeandnil( lResData ); + end; + end; + + {$ELSE} + var + Rejestr: TResourceStream; + begin + try + Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); + try + Rejestr.Read(Fonts[ aID ].Width, 256); + finally + Rejestr.Free; + end; + {$ENDIF} + + except + Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); + end; + end; + +var + font: HFONT; // Windows Font ID + h_dc: hdc; + Pet: integer; +begin + ActFont := 0; + + Log.LogStatus( '' , '---------------------------'); + + Log.LogStatus( 'Font' , '---------------------------'); + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', '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', 'PNG', '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', 'PNG', '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', 'PNG', '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', 'BMP', 'Arrow', 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); + +{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Rejestr.Read(Fonts[4].Width, 256); + Rejestr.Free;} + + for Pet := 0 to 255 do + Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2; + + for Pet := 0 to 255 do + Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2; + + for Pet := 0 to 255 do + Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1; + +{ for Pet := 0 to 255 do + Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; + i: integer; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + for i := 0 to Length(text) do + begin + Letter := Text[i]; + // Bugfix: does not work with FPC, probably because a part of text is assigned to itself + //text := pchar(Copy(text, 2, Length(text)-1)); + 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; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + // H := 30; + + // 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; + + // 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; + + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +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; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +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 +*) + + // 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; + +function NextPowerOfTwo(Value: Integer): Integer; +// tyty to Asphyre +begin + Result:= 1; + asm + xor ecx, ecx + bsr ecx, Value + inc ecx + shl Result, cl + end; +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 ); + 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, 0, intermediary, 0); + + 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; + + +{$IFDEF LAZARUS} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + + +end. + + -- cgit v1.2.3 From ffd5faaf020fa5f8504c2b8b90e5daf93ed1edaf Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 28 Jan 2008 09:31:22 +0000 Subject: TTexture.Z was never initialized (TTextureUnit.LoadTexture). In FPC (not in delphi) this resulted in a floating-point error when calling glVertex3f(x1, y1, z) in DrawTexture (UDrawTexture.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@807 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2289 ++++++++++++++++++++-------------------- 1 file changed, 1145 insertions(+), 1144 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 82dedf45..770b88bd 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1144 +1,1145 @@ -unit UTexture; -// added for easier debug disabling -{$undef blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - function LoadImage(Identifier: PChar): PSDL_Surface; - function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; - procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); - function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; - procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - - public - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) -// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) -// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) -// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - StrUtils, dialogs; - -const - fmt_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); - fmt_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); - - -Constructor TTextureUnit.Create; -begin - inherited Create; -end; - -Destructor TTextureUnit.Destroy; -begin - inherited Destroy; -end; - -function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; -end; - -// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ - 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; -// ----------------------------------------------- - -function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_rgb; - - - if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then - begin - TempSurface:=TexSurface; - TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - Result:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); -end; - -procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - TexSurface:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - with TempSurface^.format^ do - TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); - SDL_SetAlpha(TexSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface,nil,TexSurface,nil); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - //returns hue within range [0.0-6.0) - function col2h(Color:Cardinal):double; - var - clr,hls: array[0..2] of double; - delta: double; - begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - // this is for safety reasons - if delta = 0.0 then delta:=0.000000000001; - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; - end; - procedure ColorizePixel(Pix: PByteArray; hue: Double); - var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; - begin - hls[0]:=hue; - - clr[0] := Pix[0]/255; - clr[1] := Pix[1]/255; - clr[2] := Pix[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) - // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - DestinationHue:=col2h(Col); - for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do - ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: Cardinal; -begin - Log.BenchmarkStart(4); - Mipmapping := true; -(* - Log.LogStatus( '', '' ); - - if Identifier = nil then - Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') - else - Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); -*) - - // load texture data into memory - {$ifdef blindydebug} - Log.LogStatus('',' ----------------------------------------------------'); - Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - - // convert pixel format as needed - {$ifdef blindydebug} - Log.LogStatus('',' AdjustPixelFormat'); - {$endif} - AdjustPixelFormat(TexSurface, Typ); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ScaleTexture'); - {$endif} - ScaleTexture(TexSurface,newWidth,newHeight); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : typ='+Typ); - {$endif} - - - - // don't actually understand, if this is needed... - // this should definately be changed... together with all this - // cover cache stuff - if (CreateCacheMipmap) and (Typ='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - if assigned(MipmapSurface) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' BlitSurface Stuff'); - {$endif} - // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end - else - begin - Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); - end; - end; - // should i create a cache texture, if Covers.W/H are larger? - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-2'); - {$endif} - - - // now we might colorize the whole thing - if Typ='Colorized' then - ColorizeTexture(TexSurface,Col); - - // save actual dimensions of our texture - oldWidth:=newWidth; - oldHeight:=newHeight; - // make texture dimensions be powers of 2 - newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); - newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitTexture(TexSurface,newWidth,newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - {$ifdef blindydebug} - Log.LogStatus('',' JB-3'); - {$endif} - - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - - // JB_linux : this is causing AV's on linux... ActText seems to be nil ! -// {$IFnDEF win32} -// if pointer(ActTex) = nil then -// exit; -// {$endif} - - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - if Typ = 'Transparent Range' then - // set alpha to 256-green-component (not sure) - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; -} -{ - if Typ = 'Font' then - // either create luminance-alpha texture - // or use transparency from differently saved file - // or do something totally different (text engine with ttf) - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then - begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - Result.Name := Identifier; - - SDL_FreeSurface(TexSurface); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-7'); - {$endif} - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - - if Name = '' then - exit; - - // find texture entry - T := FindTexture(Name); - - if T = -1 then - begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then - begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$ifdef blindydebug} - Log.LogStatus('done',' '); - {$endif} - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - end; - - if FromCache and Covers.CoverExists(Name) then - begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$undef blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; +end; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : typ='+Typ); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} + + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + Result.X := 0; + Result.Y := 0; + Result.Z := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From 6fa012e73a04959d69307911b90f526148c8352a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 4 Feb 2008 23:10:16 +0000 Subject: small changes to check linux compilation. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@808 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 2115428f..882376a2 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -128,7 +128,7 @@ end; function TPlatformLinux.GetLogPath : WideString; begin if FindCmdLineSwitch( cUseLocalPaths ) then - result := inherited + result := ExtractFilePath(ParamStr(0)) else result := '/var/log/UltraStarDeluxe/'; end; @@ -136,7 +136,7 @@ end; function TPlatformLinux.GetGameSharedPath : WideString; begin if FindCmdLineSwitch( cUseLocalPaths ) then - result := inherited + result := ExtractFilePath(ParamStr(0)) else result := '/usr/share/UltraStarDeluxe/'; end; @@ -144,7 +144,7 @@ end; function TPlatformLinux.GetGameUserPath : WideString; begin if FindCmdLineSwitch( cUseLocalPaths ) then - result := inherited + result := ExtractFilePath(ParamStr(0)) else result := get_homedir()+'/.UltraStarDeluxe/'; end; @@ -164,7 +164,7 @@ end; // Maybe this should be TPlatformBase.Halt() procedure TPlatformLinux.Halt; begin - application.terminate; + halt(); end; function TPlatformLinux.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; @@ -182,7 +182,8 @@ var SR: TSearchRec; // for parsing song directory begin Result := ''; - if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then + begin Result := SR.Name; end; // if SysUtils.FindClose(SR); -- cgit v1.2.3 From 059d0bf5aa52228b3d968b21597546f6ddb5a967 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 13:26:43 +0000 Subject: replaced Recording with AudioInputProcessor to conform to the new interface. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@812 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioInput_Portaudio.pas | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioInput_Portaudio.pas b/Game/Code/Classes/UAudioInput_Portaudio.pas index 853fc35b..8073a7f3 100644 --- a/Game/Code/Classes/UAudioInput_Portaudio.pas +++ b/Game/Code/Classes/UAudioInput_Portaudio.pas @@ -167,8 +167,8 @@ begin SC := 0; // init array-size to max. input-devices count - SetLength(Recording.SoundCard, apiInfo^.deviceCount); // fix deviceCountL - for i:= 0 to High(Recording.SoundCard) do + SetLength(AudioInputProcessor.SoundCard, apiInfo^.deviceCount); // fix deviceCountL + for i:= 0 to High(AudioInputProcessor.SoundCard) do begin // convert API-specific device-index to global index deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); @@ -180,7 +180,7 @@ begin // TODO: free object on termination paSoundCard := TPortaudioSoundCard.Create(); - Recording.SoundCard[SC] := paSoundCard; + AudioInputProcessor.SoundCard[SC] := paSoundCard; // retrieve device-name deviceName := deviceInfo^.name; @@ -262,7 +262,7 @@ begin end; // adjust size to actual input-device count - SetLength(Recording.SoundCard, SC); + SetLength(AudioInputProcessor.SoundCard, SC); Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); @@ -280,8 +280,8 @@ var PlayerLeft, PlayerRight: integer; CaptureSoundLeft, CaptureSoundRight: TSound; begin - for S := 0 to High(Recording.Sound) do - Recording.Sound[S].BufferLong[0].Clear; + for S := 0 to High(AudioInputProcessor.Sound) do + AudioInputProcessor.Sound[S].BufferLong[0].Clear; for SC := 0 to High(Ini.CardList) do begin PlayerLeft := Ini.CardList[SC].ChannelL-1; @@ -290,11 +290,11 @@ begin if PlayerRight >= PlayersPlay then PlayerRight := -1; if (PlayerLeft > -1) or (PlayerRight > -1) then begin if (PlayerLeft > -1) then - CaptureSoundLeft := Recording.Sound[PlayerLeft] + CaptureSoundLeft := AudioInputProcessor.Sound[PlayerLeft] else CaptureSoundLeft := nil; if (PlayerRight > -1) then - CaptureSoundRight := Recording.Sound[PlayerRight] + CaptureSoundRight := AudioInputProcessor.Sound[PlayerRight] else CaptureSoundRight := nil; @@ -330,7 +330,7 @@ function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longwor timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; inputDevice: Pointer): Integer; cdecl; begin - Recording.HandleMicrophoneData(input, frameCount*4, inputDevice); + AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice); result := paContinue; end; @@ -350,7 +350,7 @@ var stream: PPaStream; paSoundCard: TPortaudioSoundCard; begin - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + paSoundCard := TPortaudioSoundCard(AudioInputProcessor.SoundCard[Card]); paSoundCard.CaptureSoundLeft := CaptureSoundLeft; paSoundCard.CaptureSoundRight := CaptureSoundRight; @@ -401,7 +401,7 @@ var stream: PPaStream; paSoundCard: TPortaudioSoundCard; begin - paSoundCard := TPortaudioSoundCard(Recording.SoundCard[Card]); + paSoundCard := TPortaudioSoundCard(AudioInputProcessor.SoundCard[Card]); stream := paSoundCard.RecordStream; if(stream <> nil) then begin Pa_StopStream(stream); -- cgit v1.2.3 From eafa73ec3181ed45a8a6fdea8ef64fc9a1e867b3 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 13:37:02 +0000 Subject: Introduction of config-file mechanism. For now just the windows version. Linux and MacOSX later. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@813 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UConfig.pas | 164 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 164 insertions(+) create mode 100644 Game/Code/Classes/UConfig.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UConfig.pas b/Game/Code/Classes/UConfig.pas new file mode 100644 index 00000000..51e9348e --- /dev/null +++ b/Game/Code/Classes/UConfig.pas @@ -0,0 +1,164 @@ +unit UConfig; + +// ------------------------------------------------------------------- +// Note on version comparison (for developers only): +// ------------------------------------------------------------------- +// Delphi (in contrast to FPC) DOESN'T support MACROS. So we +// can't define a macro like VERSION_MAJOR(version) to extract +// parts of the version-number or to create version numbers for +// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro. +// So we have to define constants for every part of the version here. +// +// In addition FPC (in contrast to delphi) DOES NOT support floating- +// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23}) +// It also DOESN'T support arithmetic operations so we aren't able to +// compare versions this way (brackets aren't supported too): +// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))} +// +// Hence we have to use fixed numbers in the directives. At least +// Pascal allows leading 0s so 0005 equals 5 (octals are +// preceded by & and not by 0 in FPC). +// We also fix the count of digits for each part of the version number +// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version) +// +// A check for a library with at least a version of 2.5.11 would look +// like this: +// {$IF LIB_VERSION >= 002005011} +// +// If you just need to check the major version do this: +// {$IF LIB_VERSION_MAJOR >= 23} +// +// IMPORTANT: +// Because this unit must be included in a uses-section it is +// not possible to use the version-numbers in this uses-clause. +// Example: +// interface +// uses +// versions, // include this file +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined +// const +// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK +// uses +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK +// +// Even if this file was an include-file no constants could be declared +// before the interface's uses clause. +// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers +// but this is incompatible to Delphi. In addition macros do not allow expand +// arithmetic expressions. Although you can define +// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} +// the following check would fail: +// {$IF FPC_VERSION_INT >= 002002000} +// would fail because FPC_VERSION_INT is interpreted as a string. +// +// PLEASE consider this if you use version numbers in $IF compiler- +// directives. Otherwise you might break portability. +// ------------------------------------------------------------------- + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Sysutils; + +const + // include config-file + {$DEFINE IncludeConstants} + {$IF Defined(MSWindows)} + {$I ../config-win.inc} + {$ELSEIF Defined(Linux)} + {$I ../config-linux.inc} + {$ELSEIF Defined(Darwin)} + {$I ../config-macosx.inc} + {$ELSE} + {$MESSAGE Fatal 'Unknown OS'} + {$IFEND} + +{* Libraries *} + + VERSION_MAJOR = 1000000; + VERSION_MINOR = 1000; + VERSION_RELEASE = 1; + + (* + * FPC_VERSION is already defined as a macro by FPC itself. + * You should use the built-in macros + * FPC_VERSION (=PPC_MAJOR) + * FPC_RELEASE (=PPC_MINOR) + * FPC_PATCH (=PPC_RELEASE) + * instead of the PPC_* ones defined here. + * This way Windows users do not need to set this. + * + * Note: It might be necessary to enable macros ({$MACRO ON} or -Sm) + * first if you want to use the FPC_* macros. + * In FPC 2.2.0 they work even without macros being enabled but + * this might be different in other versions. + * + * Example (Check for version >= 2.0.1): + * {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and + * ( (FPC_RELEASE > 0) or ((FPC_RELEASE = 0) and + * (FPC_PATCH >= 1)) ))} + * {$DEFINE FPC_VER_201_PLUS} + * {$ENDIF} + * + * IMPORTANT: do NOT check this way: + * {$IF (FPC_VERSION >= 2) and (FPC_RELEASE >= 0) and (FPC_PATCH >= 1)} + * ... + * In this case version 3.0.0 does not match because Patch 0 is less than 1. + *) + + //PPC_VERSION_MAJOR = @PPC_VERSION_MAJOR@; + //PPC_VERSION_MINOR = @PPC_VERSION_MINOR@; + //PPC_VERSION_RELEASE = @PPC_VERSION_RELEASE@; + //PPC_VERSION = (PPC_VERSION_MAJOR * VERSION_MAJOR) + + // (PPC_VERSION_MINOR * VERSION_MINOR) + + // (PPC_VERSION_RELEASE * VERSION_RELEASE); + + {$IFDEF LAZARUS} + LAZARUS_VERSION = (LAZARUS_VERSION_MAJOR * VERSION_MAJOR) + + (LAZARUS_VERSION_MINOR * VERSION_MINOR) + + (LAZARUS_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HaveFFMpeg} + + LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) + + (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) + + (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + + (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); + + {$ENDIF} + + {$IFDEF HaveSWScale} + LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + + (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + + (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HaveProjectM} + PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + + (PROJECTM_VERSION_MINOR * VERSION_MINOR) + + (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HavePortaudio} + PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + + (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + + (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + +implementation + +end. -- cgit v1.2.3 From 89ac41a2ccb85d6dfccb501ff4877231cab72094 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 13:43:38 +0000 Subject: Update of the ffmpeg headers to their current trunk versions. IMPORTANT: parameter of av_free_packet is a pointer now procedure av_free_packet (pkt: PAVPacket); as it is with av_free() and av_freep() git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@814 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 11 ++++++----- Game/Code/Classes/UVideo.pas | 4 ++-- 2 files changed, 8 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas index 4cd6ec37..c705d603 100644 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -45,7 +45,8 @@ uses {$ENDIF} UIni, UMain, - UThemes; + UThemes, + UConfig; type @@ -334,7 +335,7 @@ begin if(av_read_frame(stream.pFormatCtx, packet) < 0) then begin // check for end-of-file (eof is not an error) - {$IF (LIBAVFORMAT_MAJOR_VERSION >= 52)} + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} pbIOCtx := stream.pFormatCtx^.pb; {$ELSE} pbIOCtx := @stream.pFormatCtx^.pb; @@ -370,7 +371,7 @@ begin end else begin - av_free_packet(packet); + av_free_packet(@packet); end; end; @@ -428,7 +429,7 @@ begin if (pkt.data <> nil) then begin - av_free_packet(pkt); + av_free_packet(@pkt); end; if (packetQueue.quit) then @@ -739,7 +740,7 @@ begin while(pkt <> nil) do begin pkt1 := pkt^.next; - av_free_packet(pkt^.pkt); + av_free_packet(@pkt^.pkt); av_freep(pkt); pkt := pkt1; end; diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index c30b271e..db7e3ffd 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -286,7 +286,7 @@ begin try // if AVPacket.data <> nil then - av_free_packet( AVPacket ); // JB-ffmpeg + av_free_packet( @AVPacket ); // JB-ffmpeg except // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) end; @@ -308,7 +308,7 @@ begin // release internal packet structure created by av_read_frame try // if AVPacket.data <> nil then - av_free_packet( AVPacket ); // JB-ffmpeg + av_free_packet( @AVPacket ); // JB-ffmpeg except // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) end; -- cgit v1.2.3 From c09529e6ab6ecbf2d5ba2ac8f29713ba0101e55a Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 13:57:27 +0000 Subject: Removed the "use nil instead of 0" warnings git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@815 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UVideo.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index db7e3ffd..66c0c8e6 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -435,7 +435,7 @@ begin VideoTime := 0; LastFrameTime := 0; TimeDifference := 0; - VideoFormatContext := 0; + VideoFormatContext := nil; // writeln( aFileName ); @@ -587,7 +587,7 @@ begin {$IFDEF UseSWScale} SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), dataX, dataY, integer(PIX_FMT_RGB24), - SWS_FAST_BILINEAR, 0, 0, 0); + SWS_FAST_BILINEAR, nil, nil, nil); if SoftwareScaleContext <> Nil then writeln('got swscale context') else begin -- cgit v1.2.3 From 0d445e4ef186d6daee3a1545609a1528fe31fa10 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 14:15:34 +0000 Subject: Removed the FPC_V220 define. Now the build-in FPC_VERSION, FPC_RELEASE and FPC_PATCH macros are used. So no need to define the version in a config-file anymore (especially in windows). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@816 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index 882376a2..b962d8a5 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -28,18 +28,25 @@ type implementation +// check for version of FPC >= 2.2.0 +{$IFDEF FPC} + {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))} + {$DEFINE FPC_VERSION_2_2_0_PLUS} + {$IFEND} +{$ENDIF} + uses libc, uCommandLine, -{$IFNDEF FPC_V220} - oldlinux, -{$ELSE} +{$IFDEF FPC_VERSION_2_2_0_PLUS} BaseUnix, +{$ELSE} + oldlinux, {$ENDIF} SysUtils; -{$IFDEF FPC_V220} -Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +{$IFDEF FPC_VERSION_2_2_0_PLUS} +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; var i : Integer; TheDir : pDir; @@ -159,8 +166,7 @@ begin end; // FIXME: just a dirty-fix to make the linux build work again. -// This i the same as the corresponding function for windows -// and MacOSX. +// This i the same as the corresponding function for MacOSX. // Maybe this should be TPlatformBase.Halt() procedure TPlatformLinux.Halt; begin -- cgit v1.2.3 From 2eb92f1b07828c0631d297bd26cfb249ccbd20ef Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 16:26:40 +0000 Subject: - DirWatch-support with FPC (windows only) - added UAudioCore_Bass.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@823 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioCore_Bass.pas | 116 +++ Game/Code/Classes/USong.pas | 1459 ++++++++++++++++----------------- Game/Code/Classes/USongs.pas | 8 +- 3 files changed, 845 insertions(+), 738 deletions(-) create mode 100644 Game/Code/Classes/UAudioCore_Bass.pas (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioCore_Bass.pas b/Game/Code/Classes/UAudioCore_Bass.pas new file mode 100644 index 00000000..55148f95 --- /dev/null +++ b/Game/Code/Classes/UAudioCore_Bass.pas @@ -0,0 +1,116 @@ +unit UAudioCore_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + SysUtils; + +type + TAudioCore_Bass = class + private + public + class function ErrorGetString(): string; overload; + class function ErrorGetString(errCode: integer): string; overload; + end; + + +implementation + +uses + UMain, + ULog, + bass; + +class function TAudioCore_Bass.ErrorGetString(): string; +begin + ErrorGetString(BASS_ErrorGetCode()); +end; + +class 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_NOPAUSE: + result := 'No pause'; + 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_PLAYING: + result := 'Channel is playing'; + 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_UNKNOWN: + result := 'Unknown error'; + else + result := 'Unknown error'; + end; +end; + +end. \ No newline at end of file diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas index e5777c75..39220f1c 100644 --- a/Game/Code/Classes/USong.pas +++ b/Game/Code/Classes/USong.pas @@ -1,733 +1,726 @@ -unit USong; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ifdef Delphi} - DirWatch, - {$endif} - {$ELSE} - {$IFNDEF DARWIN} -// oldlinux, - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - UCatCovers; - -type - - - TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - TSong = class - - FileLineNo : integer; //Line which is readed at Last, for error reporting - - procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); - procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); - - function ReadTXTHeader( const aFileName : WideString ): boolean; - public - - Path: widestring; - Folder: widestring; // for sorting by folder - fFileName, - FileName: widestring; - - // sorting methods - Category: array of widestring; // I think I won't need this - Genre: widestring; - Edition: widestring; - Language: widestring; // 0.5.0: new - - Title: widestring; - Artist: widestring; - - Text: widestring; - Creator: widestring; - - Cover: widestring; - CoverTex: TTexture; - Mp3: widestring; - Background: widestring; - Video: widestring; - VideoGAP: real; - VideoLoaded: boolean; // 0.5.0: true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - - SongFile: TextFile; // all procedures in this unit operates on this file - - Base : array[0..1] of integer; - Rel : array[0..1] of integer; - Mult : integer; - MultBPM : integer; - - constructor create ( const aFileName : WideString ); - function LoadSong: boolean; - function Analyse(): boolean; - procedure clear(); - end; - -implementation - -uses - TextGL, - UIni, - UMusic, // needed for Czesci .. ( whatever that is ) - UMain; //needed for Player - -constructor TSong.create( const aFileName : WideString ); -begin - - Mult := 1; - - MultBPM := 4; - - - fFileName := aFileName; - - - if fileexists( aFileName ) then - - begin - - self.Path := ExtractFilePath( aFileName ); - self.Folder := ExtractFilePath( aFileName ); - self.FileName := ExtractFileName( aFileName ); - -(* - - if ReadTXTHeader( aFileName ) then - - begin - - LoadSong(); - - end - else - begin - Log.LogError('Error Loading SongHeader, abort Song Loading'); - Exit; - end; -*) - end; - -end; - - -function TSong.LoadSong(): boolean; - -var - TempC: char; - Tekst: string; - CP: integer; // Current Player (0 or 1) - Pet: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I: Integer; -begin - Result := false; - - if not FileExists(Path + PathDelim + FileName) then - begin - Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'WczytajCzesci'); - exit; - end; - - try - MultBPM := 4; // 4 - mnoznik dla czasu nut - Mult := 1; // 4 - dokladnosc pomiaru nut - Base[0] := 100; // high number - Czesci[0].Wartosc := 0; - self.Relative := false; - Rel[0] := 0; - CP := 0; - Both := false; - - if Length(Player) = 2 then - Both := true; - - // Open song file for reading..... - FileMode := fmOpenRead; - AssignFile(SongFile, fFileName); - Reset(SongFile); - - //Clear old Song Header - if (self.Path = '') then - self.Path := ExtractFilePath(FileName); - - if (self.FileName = '') then - self.Filename := ExtractFileName(FileName); - - Result := False; - - Reset(SongFile); - FileLineNo := 0; - //Search for Note Begining - repeat - ReadLn(SongFile, Tekst); - Inc(FileLineNo); - - if (EoF(SongFile)) then - begin //Song File Corrupted - No Notes - CloseFile(SongFile); - Log.LogError('Could not load txt File, no Notes found: ' + FileName); - Result := False; - Exit; - end; - Read(SongFile, TempC); - until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); - - SetLength(Czesci, 2); - for Pet := 0 to High(Czesci) do begin - SetLength(Czesci[Pet].Czesc, 1); - Czesci[Pet].High := 0; - Czesci[Pet].Ilosc := 1; - Czesci[Pet].Akt := 0; - Czesci[Pet].Resolution := self.Resolution; - Czesci[Pet].NotesGAP := self.NotesGAP; - Czesci[Pet].Czesc[0].IlNut := 0; - Czesci[Pet].Czesc[0].HighNut := -1; - end; - - // TempC := ':'; - // TempC := Tekst[1]; // read from backup variable, don't use default ':' value - - while (TempC <> 'E') AND (not EOF(SongFile)) do - begin - - if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin - // wczytuje nute - Read(SongFile, Param1); - Read(SongFile, Param2); - Read(SongFile, Param3); - Read(SongFile, ParamS); - - // dodaje nute - if not Both then - // P1 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else begin - // P1 + P2 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - end; // if - - if TempC = '-' then - begin - // reads sentence - Read(SongFile, Param1); - if self.Relative then Read(SongFile, Param2); // read one more data for relative system - - // new sentence - if not Both then - // P1 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) - else begin - // P1 + P2 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); - NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); - end; - end; // if - - if TempC = 'B' then - begin - SetLength(self.BPM, Length(self.BPM) + 1); - Read(SongFile, self.BPM[High(self.BPM)].StartBeat); - self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; - - Read(SongFile, Tekst); - self.BPM[High(self.BPM)].BPM := StrToFloat(Tekst); - self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; - end; - - - if not Both then - begin - Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; - Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); - //Total Notes Patch - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; - for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do - begin - Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end else begin - for Pet := 0 to High(Czesci) do begin - Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; - Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); - //Total Notes Patch - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; - for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do - begin - Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - end; - end; - - Read(SongFile, TempC); - Inc(FileLineNo); - end; // while} - - CloseFile(SongFile); - except - try - CloseFile(SongFile); - except - - end; - - Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); - exit; - end; - - Result := true; -end; - - -function TSong.ReadTXTHeader(const aFileName : WideString): boolean; - -var - Line, Identifier, Value: String; - Temp : word; - Done : byte; -begin - Result := true; - Done := 0; - - //Read first Line - ReadLn (SongFile, Line); - - if (Length(Line)<=0) then - begin - Log.LogError('File Starts with Empty Line: ' + aFileName); - Result := False; - Exit; - end; - - //Read Lines while Line starts with # or its empty - While ( Length(Line) = 0 ) OR - ( Line[1] = '#' ) DO - begin - //Increase Line Number - Inc (FileLineNo); - Temp := Pos(':', Line); - - //Line has a Seperator-> Headerline - if (Temp <> 0) then - begin - //Read Identifier and Value - Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks - Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); - - //Check the Identifier (If Value is given) - if (Length(Value) <> 0) then - begin - - //----------- - //Required Attributes - //----------- - - {$IFDEF UTF8_FILENAMES} - if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then - Value := Utf8Encode(Value); - {$ENDIF} - - //Title - if (Identifier = 'TITLE') then - begin - self.Title := Value; - - //Add Title Flag to Done - Done := Done or 1; - end - - //Artist - else if (Identifier = 'ARTIST') then - begin - self.Artist := Value; - - //Add Artist Flag to Done - Done := Done or 2; - end - - //MP3 File //Test if Exists - else if (Identifier = 'MP3') AND - (FileExists(self.Path + Value)) then - begin - self.Mp3 := Value; - - //Add Mp3 Flag to Done - Done := Done or 4; - end - - //Beats per Minute - else if (Identifier = 'BPM') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; - - self.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; - - if self.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end - - //--------- - //Additional Header Information - //--------- - - // Video Gap - else if (Identifier = 'GAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - self.GAP := StrtoFloatDef (Value, 0); - end - - //Cover Picture - else if (Identifier = 'COVER') then - self.Cover := Value - - //Background Picture - else if (Identifier = 'BACKGROUND') then - self.Background := Value - - // Video File - else if (Identifier = 'VIDEO') then - begin - if (FileExists(self.Path + Value)) then - self.Video := Value - else - Log.LogError('Can''t find Video File in Song: ' + aFileName); - end - - // Video Gap - else if (Identifier = 'VIDEOGAP') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - self.VideoGAP := StrtoFloatDef (Value, 0); - end - - //Genre Sorting - else if (Identifier = 'GENRE') then - self.Genre := Value - - //Edition Sorting - else if (Identifier = 'EDITION') then - self.Edition := Value - - //Creator Tag - else if (Identifier = 'CREATOR') then - self.Creator := Value - - //Language Sorting - else if (Identifier = 'LANGUAGE') then - self.Language := Value - - // Song Start - else if (Identifier = 'START') then - begin - // Replace . with , - if (Pos('.', Value) <> 0) then - Value[Pos('.', Value)] := ','; - - self.Start := StrtoFloatDef(Value, 0); - end - - // Song Ending - else if (Identifier = 'END') then - TryStrtoInt(Value, self.Finish) - - // Resolution - else if (Identifier = 'RESOLUTION') then - TryStrtoInt(Value, self.Resolution) - - // Notes Gap - else if (Identifier = 'NOTESGAP') then - TryStrtoInt(Value, self.NotesGAP) - // Relative Notes - else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then - self.Relative := True; - - end; - end; - - if not EOf(SongFile) then - ReadLn (SongFile, Line) - else - begin - Result := False; - Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); - break; - end; - - end; - - if self.Cover = '' then - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := False; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + self.FileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + self.FileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + self.FileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + self.FileName) - else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); - end; - -end; - -procedure TSong.ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -var - Space: boolean; -begin - case Ini.Solmization of - 1: // european - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' si '; - end; - end; - 2: // japanese - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' so '; - 9..10: LyricS := ' la '; - 11: LyricS := ' shi '; - end; - end; - 3: // american - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' ti '; - end; - end; - end; // case - - with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin - SetLength(Nuta, Length(Nuta) + 1); - IlNut := IlNut + 1; - HighNut := HighNut + 1; - Muzyka.IlNut := Muzyka.IlNut + 1; - - Nuta[HighNut].Start := StartP; - if IlNut = 1 then begin - StartNote := Nuta[HighNut].Start; - if Czesci[NrCzesci].Ilosc = 1 then - Start := -100; -// Start := Nuta[HighNut].Start; - end; - - Nuta[HighNut].Dlugosc := DurationP; - Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; - - // back to the normal system with normal, golden and now freestyle notes - case TypeP of - 'F': Nuta[HighNut].Wartosc := 0; - ':': Nuta[HighNut].Wartosc := 1; - '*': Nuta[HighNut].Wartosc := 2; - end; - - Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; - - Nuta[HighNut].Ton := NoteP; - if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; - Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; - - Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); - Lyric := Lyric + Nuta[HighNut].Tekst; - - if TypeP = 'F' then - Nuta[HighNut].FreeStyle := true; - - Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; - end; // with -end; - -procedure TSong.NewSentence(NrCzesciP: integer; Param1, Param2: integer); -var -I: Integer; -begin - - // stara czesc //Alter Satz //Update Old Part - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); - - //Total Notes Patch - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; - for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do - begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; - end; - //Total Notes Patch End - - - // nowa czesc //Neuer Satz //Update New Part - SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); - Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; - Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; - - if self.Relative then - begin - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; - end - else - Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; - - Base[NrCzesciP] := 100; // high number -end; - -procedure TSong.clear(); -begin - //Main Information - Title := ''; - Artist := ''; - - //Sortings: - Genre := 'Unknown'; - Edition := 'Unknown'; - Language := 'Unknown'; //Language Patch - - //Required Information - Mp3 := ''; - {$IFDEF FPC} - setlength( BPM, 0 ); - {$ELSE} - BPM := 0; - {$ENDIF} - - GAP := 0; - Start := 0; - Finish := 0; - - //Additional Information - Background := ''; - Cover := ''; - Video := ''; - VideoGAP := 0; - NotesGAP := 0; - Resolution := 4; - Creator := ''; - -end; - -function TSong.Analyse(): boolean; -begin - Result := False; - - //Reset LineNo - FileLineNo := 0; - - //Open File and set File Pointer to the beginning - AssignFile(SongFile, self.Path + self.FileName); - - try - Reset(SongFile); - - //Clear old Song Header - self.clear; - - //Read Header - Result := self.ReadTxTHeader( FileName ) - - //And Close File - finally - CloseFile(SongFile); - end; -end; - - - -end. +unit USong; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + UCatCovers; + +type + + TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + TSong = class + FileLineNo : integer; //Line which is readed at Last, for error reporting + + procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer); + + function ReadTXTHeader( const aFileName : WideString ): boolean; + public + Path: widestring; + Folder: widestring; // for sorting by folder + fFileName, + FileName: widestring; + + // sorting methods + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new + + Title: widestring; + Artist: widestring; + + Text: widestring; + Creator: widestring; + + Cover: widestring; + CoverTex: TTexture; + Mp3: widestring; + Background: widestring; + Video: widestring; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + + SongFile: TextFile; // all procedures in this unit operates on this file + + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer; + MultBPM : integer; + + constructor create ( const aFileName : WideString ); + function LoadSong: boolean; + function Analyse(): boolean; + procedure clear(); + end; + +implementation + +uses + TextGL, + UIni, + UMusic, // needed for Czesci .. ( whatever that is ) + UMain; //needed for Player + +constructor TSong.create( const aFileName : WideString ); +begin + + Mult := 1; + + MultBPM := 4; + + + fFileName := aFileName; + + + if fileexists( aFileName ) then + + begin + + self.Path := ExtractFilePath( aFileName ); + self.Folder := ExtractFilePath( aFileName ); + self.FileName := ExtractFileName( aFileName ); + +(* + + if ReadTXTHeader( aFileName ) then + + begin + + LoadSong(); + + end + else + begin + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; +*) + end; + +end; + + +function TSong.LoadSong(): boolean; + +var + TempC: char; + Tekst: string; + CP: integer; // Current Player (0 or 1) + Pet: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Path + PathDelim + FileName) then + begin + Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); + exit; + end; + + MultBPM := 4; // multiply beat-count of note by 4 + Mult := 1; // accuracy of measurement of note + Base[0] := 100; // high number + Czesci[0].Wartosc := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + try + // Open song file for reading..... + FileMode := fmOpenRead; + AssignFile(SongFile, fFileName); + Reset(SongFile); + + //Clear old Song Header + if (self.Path = '') then + self.Path := ExtractFilePath(FileName); + + if (self.FileName = '') then + self.Filename := ExtractFileName(FileName); + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Tekst); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + CloseFile(SongFile); + Log.LogError('Could not load txt File, no Notes found: ' + FileName); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Czesci, 2); + for Pet := 0 to High(Czesci) do begin + SetLength(Czesci[Pet].Czesc, 1); + Czesci[Pet].High := 0; + Czesci[Pet].Ilosc := 1; + Czesci[Pet].Akt := 0; + Czesci[Pet].Resolution := self.Resolution; + Czesci[Pet].NotesGAP := self.NotesGAP; + Czesci[Pet].Czesc[0].IlNut := 0; + Czesci[Pet].Czesc[0].HighNut := -1; + end; + + // TempC := ':'; + // TempC := Tekst[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do + begin + + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // read notes + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + // add notes + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; // if + + if TempC = '-' then + begin + // reads sentence + Read(SongFile, Param1); + if self.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + end; // if + + if TempC = 'B' then + begin + SetLength(self.BPM, Length(self.BPM) + 1); + Read(SongFile, self.BPM[High(self.BPM)].StartBeat); + self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Tekst); + self.BPM[High(self.BPM)].BPM := StrToFloat(Tekst); + self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then + begin + Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP]; + Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric)); + //Total Notes Patch + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0; + for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do + begin + Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end else begin + for Pet := 0 to High(Czesci) do begin + Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet]; + Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric)); + //Total Notes Patch + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0; + for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do + begin + Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + end; + end; + + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + + +function TSong.ReadTXTHeader(const aFileName : WideString): boolean; + +var + Line, Identifier, Value: String; + Temp : word; + Done : byte; +begin + Result := true; + Done := 0; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + aFileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # or its empty + While ( Length(Line) = 0 ) OR + ( Line[1] = '#' ) DO + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + {$IFDEF UTF8_FILENAMES} + if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then + Value := Utf8Encode(Value); + {$ENDIF} + + //Title + if (Identifier = 'TITLE') then + begin + self.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + self.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND + (FileExists(self.Path + Value)) then + begin + self.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + // Video Gap + else if (Identifier = 'GAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.GAP := StrtoFloatDef (Value, 0); + end + + //Cover Picture + else if (Identifier = 'COVER') then + self.Cover := Value + + //Background Picture + else if (Identifier = 'BACKGROUND') then + self.Background := Value + + // Video File + else if (Identifier = 'VIDEO') then + begin + if (FileExists(self.Path + Value)) then + self.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + aFileName); + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.VideoGAP := StrtoFloatDef (Value, 0); + end + + //Genre Sorting + else if (Identifier = 'GENRE') then + self.Genre := Value + + //Edition Sorting + else if (Identifier = 'EDITION') then + self.Edition := Value + + //Creator Tag + else if (Identifier = 'CREATOR') then + self.Creator := Value + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + self.Language := Value + + // Song Start + else if (Identifier = 'START') then + begin + // Replace . with , + if (Pos('.', Value) <> 0) then + Value[Pos('.', Value)] := ','; + + self.Start := StrtoFloatDef(Value, 0); + end + + // Song Ending + else if (Identifier = 'END') then + TryStrtoInt(Value, self.Finish) + + // Resolution + else if (Identifier = 'RESOLUTION') then + TryStrtoInt(Value, self.Resolution) + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + TryStrtoInt(Value, self.NotesGAP) + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + self.Relative := True; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); + break; + end; + + end; + + if self.Cover = '' then + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + self.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + self.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + self.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +end; + +procedure TSong.ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +var + Space: boolean; +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin + SetLength(Nuta, Length(Nuta) + 1); + IlNut := IlNut + 1; + HighNut := HighNut + 1; + Muzyka.IlNut := Muzyka.IlNut + 1; + + Nuta[HighNut].Start := StartP; + if IlNut = 1 then begin + StartNote := Nuta[HighNut].Start; + if Czesci[NrCzesci].Ilosc = 1 then + Start := -100; +// Start := Nuta[HighNut].Start; + end; + + Nuta[HighNut].Dlugosc := DurationP; + Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Nuta[HighNut].Wartosc := 0; + ':': Nuta[HighNut].Wartosc := 1; + '*': Nuta[HighNut].Wartosc := 2; + end; + + Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc; + + Nuta[HighNut].Ton := NoteP; + if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton; + Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12; + + Nuta[HighNut].Tekst := Copy(LyricS, 2, 100); + Lyric := Lyric + Nuta[HighNut].Tekst; + + if TypeP = 'F' then + Nuta[HighNut].FreeStyle := true; + + Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc; + end; // with +end; + +procedure TSong.NewSentence(NrCzesciP: integer; Param1, Param2: integer); +var +I: Integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP]; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric)); + + //Total Notes Patch + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0; + for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1); + Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1; + Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1; + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1; + + if self.Relative then + begin + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + Rel[NrCzesciP] := Rel[NrCzesciP] + Param2; + end + else + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1; + + Base[NrCzesciP] := 100; // high number +end; + +procedure TSong.clear(); +begin + //Main Information + Title := ''; + Artist := ''; + + //Sortings: + Genre := 'Unknown'; + Edition := 'Unknown'; + Language := 'Unknown'; //Language Patch + + //Required Information + Mp3 := ''; + {$IFDEF FPC} + setlength( BPM, 0 ); + {$ELSE} + BPM := 0; + {$ENDIF} + + GAP := 0; + Start := 0; + Finish := 0; + + //Additional Information + Background := ''; + Cover := ''; + Video := ''; + VideoGAP := 0; + NotesGAP := 0; + Resolution := 4; + Creator := ''; + +end; + +function TSong.Analyse(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, self.Path + self.FileName); + + try + Reset(SongFile); + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadTxTHeader( FileName ) + + //And Close File + finally + CloseFile(SongFile); + end; +end; + + + +end. diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 53d5556f..97e8d073 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -17,9 +17,7 @@ interface uses {$IFDEF MSWINDOWS} Windows, - {$IFDEF Delphi} - DirWatch, - {$ENDIF} + DirWatch, {$ELSE} {$IFNDEF DARWIN} syscall, @@ -66,7 +64,7 @@ type fWatch : longint; fParseSongDirectory : boolean; fProcessing : boolean; - {$ifdef Delphi} + {$ifdef MSWINDOWS} fDirWatch : TDirectoryWatch; {$endif} procedure int_LoadSongList; @@ -151,7 +149,7 @@ begin SongList := TList.create(); - {$ifdef Delphi} + {$ifdef MSWINDOWS} fDirWatch := TDirectoryWatch.create(nil); fDirWatch.OnChange := DoDirChanged; fDirWatch.Directory := SongPath; -- cgit v1.2.3 From 575a05b31780cc02145e14476d8f5e343b676ad4 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 16:31:20 +0000 Subject: Changed Delphi-define to MSWINDOWS (works in FPC too) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@824 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 9718b2eb..7e76c9c4 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -422,7 +422,7 @@ var Params: Cardinal; begin Result := -1; - {$IFDEF Delphi} + {$IFDEF MSWINDOWS} If (lParam<>nil) then begin Params := MB_OK; -- cgit v1.2.3 From 5df25a794dd5ba29729574560a1622f77f6b7048 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 16:34:22 +0000 Subject: updated to use the new UConfig.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@825 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/Ulazjpeg.pas | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas index a5271a7e..2414002c 100644 --- a/Game/Code/Classes/Ulazjpeg.pas +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -16,13 +16,15 @@ } unit Ulazjpeg; -{$mode objfpc}{$H+} +{$mode delphi} + {$I switches.inc} interface uses - SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG; + SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG, + UConfig; type TJPEGQualityRange = TFPJPEGCompressionQuality; @@ -34,17 +36,17 @@ type FProgressiveEncoding: boolean; FQuality: TJPEGQualityRange; protected -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; {$ELSE} procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; -{$ENDIF} +{$IFEND} procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; {$ELSE} procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; -{$ENDIF} +{$IFEND} public constructor Create; override; class function GetFileExtensions: string; override; @@ -65,26 +67,26 @@ implementation { TJPEGImage } -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); {$ELSE} procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); -{$ENDIF} +{$IFEND} var JPEGReader: TFPReaderJPEG; begin if ImgReader is TFPReaderJPEG then begin JPEGReader:=TFPReaderJPEG(ImgReader); JPEGReader.Performance:=Performance; -{$IFDEF LAZARUS_V0924} - JPEGReader.OnProgress:=@Progress; -{$ENDIF} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + JPEGReader.OnProgress:=Progress; +{$IFEND} end; -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 inherited InitFPImageReader(IntfImg, ImgReader); {$ELSE} inherited InitFPImageReader(ImgReader); -{$ENDIF} +{$IFEND} end; procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); @@ -98,11 +100,11 @@ begin inherited FinalizeFPImageReader(ImgReader); end; -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); {$ELSE} procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); -{$ENDIF} +{$IFEND} var JPEGWriter: TFPWriterJPEG; begin @@ -111,15 +113,15 @@ begin if JPEGWriter<>nil then ; JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; JPEGWriter.CompressionQuality:=CompressionQuality; -{$IFDEF LAZARUS_V0924} - JPEGWriter.OnProgress:=@Progress; -{$ENDIF} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + JPEGWriter.OnProgress:=Progress; +{$IFEND} end; -{$IFDEF LAZARUS_V0924} +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 inherited InitFPImageWriter(IntfImg, ImgWriter); {$ELSE} inherited InitFPImageWriter(ImgWriter); -{$ENDIF} +{$IFEND} end; class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; -- cgit v1.2.3 From 2e6592ceadb3e3c910164c76595e7ae435b8823a Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 17:13:47 +0000 Subject: Added a SafeWriteLn()-function to support thread-safe console-output. This is used in all Log...-Methods now (not for file-output yet). Don't use WriteLn anymore from external threads (for example in SDL or Portaudio Callbacks), otherwise FPC will crash. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@826 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 642 +++++++++++++++++++++++++-------------------- 1 file changed, 364 insertions(+), 278 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index c9c87a92..542fa0b3 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -1,278 +1,364 @@ -unit ULog; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes; - -type - TLog = class - BenchmarkTimeStart: array[0..7] of real; - BenchmarkTimeLength: array[0..7] of real;//TDateTime; - - FileBenchmark: TextFile; - FileBenchmarkO: boolean; // opened - FileError: TextFile; - FileErrorO: boolean; // opened - - Title: String; //Application Title - - //Should Log Files be written - Enabled: Boolean; - - // destuctor - destructor Free; - - // benchmark - procedure BenchmarkStart(Number: integer); - procedure BenchmarkEnd(Number: integer); - procedure LogBenchmark(Text: string; Number: integer); - - // error - procedure LogError(Text: string); overload; - - //Critical Error (Halt + MessageBox) - procedure CriticalError(Text: string); - - // voice - procedure LogVoice(SoundNr: integer); - - // compability - procedure LogStatus(Log1, Log2: string); - procedure LogError(Log1, Log2: string); overload; - procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string); - end; - -var - Log: TLog; - -implementation - -uses - {$IFDEF win32} - windows, - {$ENDIF} - SysUtils, - DateUtils, -// UFiles, - UMain, - URecord, - UTime, -// UIni, // JB - Seems to not be needed. - UCommandLine; - -destructor TLog.Free; -begin - if FileBenchmarkO then CloseFile(FileBenchmark); -// if FileAnalyzeO then CloseFile(FileAnalyze); - if FileErrorO then CloseFile(FileError); -end; - -procedure TLog.BenchmarkStart(Number: integer); -begin - BenchmarkTimeStart[Number] := USTime.GetTime; //Time; -end; - -procedure TLog.BenchmarkEnd(Number: integer); -begin - BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; -end; - -procedure TLog.LogBenchmark(Text: string; Number: integer); -var - Minutes: integer; - Seconds: integer; - Miliseconds: integer; - - MinutesS: string; - SecondsS: string; - MilisecondsS: string; - - ValueText: string; -begin - if Enabled AND (Params.Benchmark) then begin - if not FileBenchmarkO then begin - FileBenchmarkO := true; - AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); - {$I-} - Rewrite(FileBenchmark); - if IOResult = 0 then FileBenchmarkO := true; - {$I+} - - //If File is opened write Date to Benchmark File - If (FileBenchmarkO) then - begin - WriteLn(FileBenchmark, Title + ' Benchmark File'); - WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileBenchmark, '-------------------'); - - Flush(FileBenchmark); - end; - end; - - if FileBenchmarkO then begin - Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); - Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; - Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); -// ValueText := FloatToStr(BenchmarkTimeLength[Number]); - -{ ValueText := FloatToStr( - SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 - ); - if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then - ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; - WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} - - if (Minutes = 0) and (Seconds = 0) then begin - MilisecondsS := IntToStr(Miliseconds); - ValueText := MilisecondsS + ' miliseconds'; - end; - - if (Minutes = 0) and (Seconds >= 1) then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - - ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; - end; - - if Minutes >= 1 then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; - - MinutesS := IntToStr(Minutes); - - ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; - end; - - WriteLn(FileBenchmark, Text + ': ' + ValueText); - Flush(FileBenchmark); - end; - end; -end; - -procedure TLog.LogError(Text: string); -begin - if Enabled AND (not FileErrorO) then begin - //FileErrorO := true; - AssignFile(FileError, LogPath + 'Error.log'); - {$I-} - Rewrite(FileError); - if IOResult = 0 then FileErrorO := true; - {$I+} - - //If File is opened write Date to Error File - If (FileErrorO) then - begin - WriteLn(FileError, Title + ' Error Log'); - WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileError, '-------------------'); - - Flush(FileError); - end; - end; - - if FileErrorO then begin - try - WriteLn(FileError, Text); - Flush(FileError); - except - FileErrorO := false; - end; - end; - {$IFDEF DEBUG} - WriteLn('Error: ' + Text); - {$ENDIF} -end; - -procedure TLog.LogVoice(SoundNr: integer); -var - FileVoice: File; - FS: TFileStream; - FileName: string; - Num: integer; - BL: integer; -begin - for Num := 1 to 9999 do begin - FileName := IntToStr(Num); - while Length(FileName) < 4 do FileName := '0' + FileName; - FileName := LogPath + 'Voice' + FileName + '.raw'; - if not FileExists(FileName) then break - end; - - - FS := TFileStream.Create(FileName, fmCreate); - - for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin - AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); - FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size); - end; - - FS.Free; -end; - -procedure TLog.LogStatus(Log1, Log2: string); -begin - //Just for Debugging - //Comment for Release - //LogError(Log2 + ': ' + Log1); - - //If Debug => Write to Console Output - {$IFDEF DEBUG} -// WriteLn(Log2 + ': ' + Log1); - {$ENDIF} -end; - -procedure TLog.LogError(Log1, Log2: string); -begin - LogError(Log1 + ' ['+Log2+']'); -end; - -procedure TLog.CriticalError(Text: string); -begin - //Write Error to Logfile: - LogError (Text); - - {$IFDEF MSWINDOWS} - //Show Errormessage - Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); - {$ELSE} - // TODO - JB_Linux handle critical error so user can see message. - writeln( 'Critical ERROR :' ); - writeln( Text ); - {$ENDIF} - - //Exit Application - Halt; -end; - -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string); -var - f : TFileStream; -begin - f := nil; - - try - f := TFileStream.Create( filename, fmCreate); - f.Write( buf^, bufLength); - f.Free; - except - on e : Exception do begin - Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); - f.Free; - end; - end; -end; - -end. - - +unit ULog; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes; + +type + TLog = class + public + BenchmarkTimeStart: array[0..7] of real; + BenchmarkTimeLength: array[0..7] of real;//TDateTime; + + FileBenchmark: TextFile; + FileBenchmarkO: boolean; // opened + FileError: TextFile; + FileErrorO: boolean; // opened + + Title: String; //Application Title + + //Should Log Files be written + Enabled: Boolean; + + constructor Create; + + // destuctor + destructor Destroy; override; + + // benchmark + procedure BenchmarkStart(Number: integer); + procedure BenchmarkEnd(Number: integer); + procedure LogBenchmark(Text: string; Number: integer); + + // error + procedure LogError(Text: string); overload; + + //Critical Error (Halt + MessageBox) + procedure CriticalError(Text: string); + + // voice + procedure LogVoice(SoundNr: integer); + + // compability + procedure LogStatus(Log1, Log2: string); + procedure LogError(Log1, Log2: string); overload; + procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string); + end; + +procedure SafeWriteLn(const msg: string); inline; + +var + Log: TLog; + +implementation + +uses + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + DateUtils, +//UFiles, + UMain, + URecord, + UTime, +//UIni, // JB - Seems to not be needed. + {$IFDEF FPC} + sdl, + {$ENDIF} + UCommandLine; + +{$IFDEF FPC} +var + MessageList: TStringList; + ConsoleHandler: TThreadID; + ConsoleMutex: PSDL_Mutex; + ConsoleCond: PSDL_Cond; +{$ENDIF} + +{$IFDEF FPC} +{* + * The console-handlers main-function. + * TODO: create a quit-event on closing. + *} +function ConsoleHandlerFunc(param: pointer): PtrInt; +var + i: integer; +begin + while true do + begin + SDL_mutexP(ConsoleMutex); + while (MessageList.Count = 0) do + SDL_CondWait(ConsoleCond, ConsoleMutex); + for i := 0 to MessageList.Count-1 do + begin + WriteLn(MessageList[i]); + end; + MessageList.Clear(); + SDL_mutexV(ConsoleMutex); + end; + result := 0; +end; +{$ENDIF} + +{* + * With FPC console output is not thread-safe. + * Using WriteLn() from external threads (like in SDL callbacks) + * will damage the heap and crash the program. + * Most probably FPC uses thread-local-data (TLS) to lock a mutex on + * the console-buffer. This does not work with external lib's threads + * because these do not have the TLS data and so it crashes while + * accessing unallocated memory. + * The solution is to create an FPC-managed thread which has the TLS data + * and use it to handle the console-output (hence it is called Console-Handler) + * It should be safe to do so, but maybe FPC requires the main-thread to access + * the console-buffer only. In this case output should be delegated to it. + * + * TODO: - check if it is safe if an FPC-managed thread different than the + * main-thread accesses the console-buffer in FPC. + * - check if Delphi's WriteLn is thread-safe. + * - check if we need to synchronize file-output too + * - Use TEvent and TCriticalSection instead of the SDL equivalents. + * Note: If those two objects use TLS they might crash FPC too. + *} +procedure SafeWriteLn(const msg: string); +begin +{$IFDEF FPC} + SDL_mutexP(ConsoleMutex); + MessageList.Add(msg); + SDL_CondSignal(ConsoleCond); + SDL_mutexV(ConsoleMutex); +{$ELSE} + WriteLn(msg); +{$ENDIF} +end; + +constructor TLog.Create; +begin +{$IFDEF FPC} + // TODO: check for the main-thread? + //GetCurrentThreadThreadId(); + MessageList := TStringList.Create(); + ConsoleMutex := SDL_CreateMutex(); + ConsoleCond := SDL_CreateCond(); + ConsoleHandler := BeginThread(@ConsoleHandlerFunc); +{$ENDIF} +end; + +destructor TLog.Destroy; +begin + if FileBenchmarkO then CloseFile(FileBenchmark); +// if FileAnalyzeO then CloseFile(FileAnalyze); + if FileErrorO then CloseFile(FileError); +end; + +procedure TLog.BenchmarkStart(Number: integer); +begin + BenchmarkTimeStart[Number] := USTime.GetTime; //Time; +end; + +procedure TLog.BenchmarkEnd(Number: integer); +begin + BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; +end; + +procedure TLog.LogBenchmark(Text: string; Number: integer); +var + Minutes: integer; + Seconds: integer; + Miliseconds: integer; + + MinutesS: string; + SecondsS: string; + MilisecondsS: string; + + ValueText: string; +begin + if Enabled AND (Params.Benchmark) then begin + if not FileBenchmarkO then begin + FileBenchmarkO := true; + AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); + {$I-} + Rewrite(FileBenchmark); + if IOResult = 0 then FileBenchmarkO := true; + {$I+} + + //If File is opened write Date to Benchmark File + If (FileBenchmarkO) then + begin + WriteLn(FileBenchmark, Title + ' Benchmark File'); + WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileBenchmark, '-------------------'); + + Flush(FileBenchmark); + end; + end; + + if FileBenchmarkO then begin + Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); + Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; + Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); +// ValueText := FloatToStr(BenchmarkTimeLength[Number]); + +{ ValueText := FloatToStr( + SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 + ); + if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then + ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; + WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} + + if (Minutes = 0) and (Seconds = 0) then begin + MilisecondsS := IntToStr(Miliseconds); + ValueText := MilisecondsS + ' miliseconds'; + end; + + if (Minutes = 0) and (Seconds >= 1) then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + + ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; + end; + + if Minutes >= 1 then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; + + MinutesS := IntToStr(Minutes); + + ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; + end; + + WriteLn(FileBenchmark, Text + ': ' + ValueText); + Flush(FileBenchmark); + end; + end; +end; + +procedure TLog.LogError(Text: string); +begin + if Enabled AND (not FileErrorO) then begin + //FileErrorO := true; + AssignFile(FileError, LogPath + 'Error.log'); + {$I-} + Rewrite(FileError); + if IOResult = 0 then FileErrorO := true; + {$I+} + + //If File is opened write Date to Error File + If (FileErrorO) then + begin + WriteLn(FileError, Title + ' Error Log'); + WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(FileError, '-------------------'); + + Flush(FileError); + end; + end; + + if FileErrorO then begin + try + WriteLn(FileError, Text); + Flush(FileError); + except + FileErrorO := false; + end; + end; + {$IFDEF DEBUG} + SafeWriteLn('Error: ' + Text); + {$ENDIF} +end; + +procedure TLog.LogVoice(SoundNr: integer); +var + FileVoice: File; + FS: TFileStream; + FileName: string; + Num: integer; + BL: integer; +begin + for Num := 1 to 9999 do begin + FileName := IntToStr(Num); + while Length(FileName) < 4 do FileName := '0' + FileName; + FileName := LogPath + 'Voice' + FileName + '.raw'; + if not FileExists(FileName) then break + end; + + + FS := TFileStream.Create(FileName, fmCreate); + + for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin + AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); + FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size); + end; + + FS.Free; +end; + +procedure TLog.LogStatus(Log1, Log2: string); +begin + //Just for Debugging + //Comment for Release + //LogError(Log2 + ': ' + Log1); + + //If Debug => Write to Console Output + {$IFDEF DEBUG} + // SafeWriteLn(Log2 + ': ' + Log1); + {$ENDIF} +end; + +procedure TLog.LogError(Log1, Log2: string); +begin + LogError(Log1 + ' ['+Log2+']'); +end; + +procedure TLog.CriticalError(Text: string); +begin + //Write Error to Logfile: + LogError (Text); + + {$IFDEF MSWINDOWS} + //Show Errormessage + Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK); + {$ELSE} + // TODO - JB_Linux handle critical error so user can see message. + SafeWriteLn( 'Critical ERROR :' ); + SafeWriteLn( Text ); + {$ENDIF} + + //Exit Application + Halt; +end; + +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string); +var + f : TFileStream; +begin + f := nil; + + try + f := TFileStream.Create( filename, fmCreate); + f.Write( buf^, bufLength); + f.Free; + except + on e : Exception do begin + Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); + f.Free; + end; + end; +end; + +end. + + -- cgit v1.2.3 From dee94f5dae9e6b5ae6c7b54a12a567745abc8dc3 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 20:36:19 +0000 Subject: General: - cleanup and adaption of SingDrawOscilloscope Portaudio/SDL audio output: - stuttering in portaudio output has been fixed (SDL_MixBuffers cannot be used without initializing the SDL audio stuff first, so it is not usable with portaudio. Now SDL is used for audio-output instead of portaudio (although the file-name is UAudioPlayback_Portaudio.pas at the moment). - cleaner file closing - volume adjustment UMusic: - cleanup of the audio-interfaces - introduced TNoteType = (ntFreestyle, ntNormal, ntGolden) - some bug-fixes - introduced TSoundLibrary. This is library for all in-game sounds used by USDX. Instead of calling AudioPlayer.PlaySwoosh you should call AudioPlayer.PlaySound(SoundLib.Swoosh) now. You might call SoundLib.Swoosh.Play too, but this is not recommended at the moment because SoundLib.Swoosh could be nil if the file was not found. The SoundLibrary approach is much cleaner than the previous one. The AudioPlayer does not have to specify a Play... and Stop... method for every available sound anymore. In addition it is not an AudioPlayers responsibility to init the in-game sounds. URecord: - polish to english translation of some variables - CaptureSoundLeft/Right is CaptureChannel[0/1] now - TSoundCardInput -> TAudioInputDeviceSource - TGenericSoundCard.Input -> TGenericSoundCard.Source - autocorrelation algorithm more readable now - Clean-up of the audio-input interface - moved cloned code of the input-classes to one base class (TAudioInputBase) - Cleaner finalization - Start-/StopCapture will not crash anymore in the recording-options menu - Fixed several bugs in the autocorrelation stuff (e.g. wrong usage of $10000) - SzczytJest (now ToneValid) was not used correctly. ToneValid is set to true if a valid tone was found (= the sound was louder than the threshold -> no background noise). If i remember correctly the sound was accepted although the tone was invalid. So the old data was used although noone was singing. This resulted in some sort of ghost-singer effect. UIni: - moved TIni.Card to TScreenOptionsRecord.Card because it is not stored in the ini-file and will not be in the future. - TIni.CardList ist now TIni.InputDeviceConfig. The name cardlist was misleading because it just specifies input- but no output-devices. In addition a soundcard can have multiple input-devices (at least in linux). - bugfix on InputDeviceConfig (formerly CardList) usage. USDX expected that the indices of the corresponding elements in TIni.InputDeviceConfig[] and TAudioInputProcessor.Device[] were the same. This is wrong. If device 2 was defined at first place in the ini and device 1 at the second, the indices of the two arrays didn't match (they were swapped) erroneously. To fix this and to support the item listed below the index to TIni.InputDeviceConfig[] is now stored in TAudioInputDevice.CfgIndex. NOTE: InputDeviceConfig[] contains configurations of non-available (unplugged) devices. Iterate over TAudioInputProcessor.Device[] for available devices. - configurations of external devices that are not plugged in will not be deleted anymore. - multiple definitions of one device in the ini-file will not crash USDX anymore - CardList[I].ChannelL/R now are InputDeviceConfig[I].ChannelToPlayerMap[0/1]. I think the new name is more intuitive because it maps a channel to a player number. Now the both vars are joint to one array. Now it is possible to use loops to process them and we might support more than two input channels on one device in the future (if such devices exist) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@827 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 197 +-- Game/Code/Classes/UAudioInput_Bass.pas | 490 +++----- Game/Code/Classes/UAudioInput_Portaudio.pas | 331 ++--- Game/Code/Classes/UAudioPlayback_Bass.pas | 450 +++---- Game/Code/Classes/UAudioPlayback_Portaudio.pas | 608 +++++---- Game/Code/Classes/UDraw.pas | 20 +- Game/Code/Classes/UIni.pas | 1599 ++++++++++++------------ Game/Code/Classes/UMain.pas | 35 +- Game/Code/Classes/UMedia_dummy.pas | 474 +++---- Game/Code/Classes/UMusic.pas | 915 +++++++------- Game/Code/Classes/URecord.pas | 850 ++++++++----- 11 files changed, 3003 insertions(+), 2966 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas index c705d603..646e9eef 100644 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -17,36 +17,33 @@ interface {$MODE Delphi} {$ENDIF} -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - SysUtils, - SDL, - avcodec, // FFMpeg Audio file decoding - avformat, - avutil, - avio, // used for url_ferror - mathematics, // used for av_rescale_q - ULog, - UMusic; +{$I ../switches.inc} + + +uses + Classes, + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + UMusic; implementation uses - {$IFDEF LAZARUS} - lclintf, - {$ifndef win32} - libc, - {$endif} - {$ENDIF} - UIni, - UMain, - UThemes, - UConfig; + {$ifndef win32} + libc, + {$endif} + UIni, + UMain, + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + avio, // used for url_ferror + mathematics, // used for av_rescale_q + SDL, + ULog, + UConfig; type @@ -106,12 +103,12 @@ type ffmpegStreamIndex : Integer; ffmpegStream : PAVStream; - // "static" vars for DecodeFrame + // state-vars for DecodeFrame pkt : TAVPacket; audio_pkt_data : PChar; audio_pkt_size : integer; - // "static" vars for AudioCallback + // state-vars for AudioCallback audio_buf_index : cardinal; audio_buf_size : cardinal; audio_buf : TAudioBuffer; @@ -127,8 +124,7 @@ type procedure Close(); override; function GetLength(): real; override; - function GetChannelCount(): cardinal; override; - function GetSampleRate(): cardinal; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; function GetPosition: real; override; procedure SetPosition(Time: real); override; function IsEOF(): boolean; override; @@ -169,7 +165,7 @@ begin audio_buf_index := 0; audio_buf_size := 0; - FillChar(pkt, sizeof(TAVPacket), #0); + FillChar(pkt, sizeof(TAVPacket), 0); Self.pFormatCtx := pFormatCtx; Self.pCodecCtx := pCodecCtx; @@ -221,14 +217,12 @@ begin result := pFormatCtx^.duration / AV_TIME_BASE; end; -function TFFMpegDecodeStream.GetChannelCount(): cardinal; -begin - result := pCodecCtx^.channels; -end; - -function TFFMpegDecodeStream.GetSampleRate(): cardinal; +function TFFMpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; begin - result := pCodecCtx^.sample_rate; + result.Channels := pCodecCtx^.channels; + result.SampleRate := pCodecCtx^.sample_rate; + //result.Format := pCodecCtx^.sample_fmt; // sample_fmt not yet used by FFMpeg + result.Format := asfS16; // use FFMpeg's standard format end; function TFFMpegDecodeStream.IsEOF(): boolean; @@ -260,7 +254,7 @@ begin SDL_mutexP(lock); seekPos := Trunc(Time * AV_TIME_BASE); // FIXME: seek_flags = rel < 0 ? AVSEEK_FLAG_BACKWARD : 0 - seekFlags := 0; + seekFlags := 0;//AVSEEK_FLAG_BACKWARD; seekRequest := true; SDL_CondSignal(resumeCond); SDL_mutexV(lock); @@ -279,9 +273,9 @@ begin while (true) do begin + //SafeWriteLn('Hallo'); SDL_mutexP(stream.lock); - // wait if end-of-file reached if (eofState) then begin @@ -309,18 +303,19 @@ begin // TODO: Do we need this? // The position is converted to AV_TIME_BASE and then to the stream-specific base. // Why not convert to the stream-specific one from the beginning. - seekTarget := av_rescale_q(stream.seekPos, AV_TIME_BASE_Q, stream.ffmpegStream^.time_base); - if(av_seek_frame(stream.pFormatCtx, stream.ffmpegStreamIndex, - seekTarget, stream.seekFlags) = 0) then - begin - Log.LogStatus(stream.pFormatCtx^.filename + ': error while seeking', 'UAudioDecoder_FFMpeg'); - end - else - begin - stream.packetQueue.Flush(); - stream.packetQueue.Put(@FlushPacket); - end; - stream.seekRequest := false; + seekTarget := av_rescale_q(stream.seekPos, AV_TIME_BASE_Q, stream.ffmpegStream^.time_base); + if(av_seek_frame(stream.pFormatCtx, stream.ffmpegStreamIndex, + seekTarget, stream.seekFlags) < 0) then + begin + // this will crash in FPC due to a bug + //Log.LogStatus({stream.pFormatCtx^.filename +} ': error while seeking', 'UAudioDecoder_FFMpeg'); + end + else + begin + stream.packetQueue.Flush(); + stream.packetQueue.Put(@FlushPacket); + end; + stream.seekRequest := false; end; SDL_mutexV(stream.lock); @@ -340,8 +335,10 @@ begin {$ELSE} pbIOCtx := @stream.pFormatCtx^.pb; {$IFEND} + if(url_feof(pbIOCtx) <> 0) then begin + SafeWriteLn('feof'); eofState := true; continue; end; @@ -349,24 +346,25 @@ begin // check for errors if(url_ferror(pbIOCtx) = 0) then begin + SafeWriteLn('Errorf'); // no error -> wait for user input - SDL_Delay(100); - continue; - end - else - begin - // an error occured -> abort - // TODO: eof or quit? - eofState := true; - continue; - end; - end; - - //writeln( 'ffmpeg - av_read_frame' ); + SDL_Delay(100); + continue; + end + else + begin + // an error occured -> abort + // TODO: eof or quit? + eofState := true; + continue; + end; + end; + + //SafeWriteLn( 'ffmpeg - av_read_frame' ); if(packet.stream_index = stream.ffmpegStreamIndex) then begin - //writeln( 'packet_queue_put' ); + //SafeWriteLn( 'packet_queue_put' ); stream.packetQueue.put(@packet); end else @@ -375,7 +373,7 @@ begin end; end; - //Writeln('Done: ' + inttostr(stream.packetQueue.nbPackets)); + SafeWriteLn('Done: ' + inttostr(stream.packetQueue.nbPackets)); result := 0; end; @@ -394,21 +392,25 @@ begin begin while (audio_pkt_size > 0) do begin - //writeln( 'got audio packet' ); + //SafeWriteLn( 'got audio packet' ); data_size := bufSize; - // TODO: should be avcodec_decode_audio2 but this wont link on my ubuntu box. + {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 + len1 := avcodec_decode_audio2(pCodecCtx, @buffer, + data_size, audio_pkt_data, audio_pkt_size); + {$ELSE} // FIXME: with avcodec_decode_audio a package could contain several frames // this is not handled yet len1 := avcodec_decode_audio(pCodecCtx, @buffer, data_size, audio_pkt_data, audio_pkt_size); + {$IFEND} - //writeln('avcodec_decode_audio : ' + inttostr( len1 )); + //SafeWriteLn('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin - // if error, skip frame - //writeln( 'Skip audio frame' ); + // if error, skip frame + SafeWriteLn( 'Skip audio frame' ); audio_pkt_size := 0; break; end; @@ -444,6 +446,7 @@ begin if (audio_pkt_data = PChar(FlushPacket.data)) then begin avcodec_flush_buffers(pCodecCtx); + SafeWriteLn('Flush'); continue; end; @@ -452,11 +455,12 @@ begin begin // end-of-file reached -> set EOF-flag SetEOF(true); + SafeWriteLn('EOF'); // note: buffer is not (even partially) filled -> no data to return exit; end; - //writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + //SafeWriteLn( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); end; end; @@ -480,14 +484,14 @@ begin begin // We have already sent all our data; get more audio_size := DecodeFrame(audio_buf, sizeof(TAudioBuffer)); - //writeln('audio_decode_frame : '+ inttostr(audio_size)); + //SafeWriteLn('audio_decode_frame : '+ inttostr(audio_size)); if(audio_size < 0) then begin // If error, output silence audio_buf_size := 1024; FillChar(audio_buf, audio_buf_size, #0); - //writeln( 'Silence' ); + //SafeWriteLn( 'Silence' ); end else begin @@ -531,11 +535,11 @@ begin // init end-of-file package av_init_packet(EOFPacket); - EOFPacket.data := Pointer(PChar('EOF')); + EOFPacket.data := Pointer(PChar('EOF')); // init flush package av_init_packet(FlushPacket); - FlushPacket.data := Pointer(PChar('FLUSH')); + FlushPacket.data := Pointer(PChar('FLUSH')); result := true; end; @@ -611,7 +615,7 @@ begin end; avcodec_open(pCodecCtx, pCodec); - //writeln( 'Opened the codec' ); + //WriteLn( 'Opened the codec' ); stream := TFFMpegDecodeStream.Create(pFormatCtx, pCodecCtx, pCodec, ffmpegStreamID, ffmpegStream); @@ -671,7 +675,7 @@ begin Self.lastPkt := pkt1; inc(Self.nbPackets); - //Writeln('Put: ' + inttostr(nbPackets)); + //SafeWriteLn('Put: ' + inttostr(nbPackets)); Self.size := Self.size + pkt1^.pkt.size; SDL_CondSignal(Self.cond); @@ -705,7 +709,7 @@ begin Self.lastPkt := nil; dec(Self.nbPackets); - //Writeln('Get: ' + inttostr(nbPackets)); + //SafeWriteLn('Get: ' + inttostr(nbPackets)); Self.size := Self.size - pkt1^.pkt.size; pkt := pkt1^.pkt; @@ -734,22 +738,23 @@ procedure TPacketQueue.Flush(); var pkt, pkt1: PAVPacketList; begin - SDL_LockMutex(Self.mutex); - - pkt := Self.firstPkt; - while(pkt <> nil) do - begin - pkt1 := pkt^.next; - av_free_packet(@pkt^.pkt); - av_freep(pkt); - pkt := pkt1; - end; - Self.lastPkt := nil; - Self.firstPkt := nil; - Self.nbPackets := 0; - Self.size := 0; - - SDL_UnlockMutex(Self.mutex); + SDL_LockMutex(Self.mutex); + + pkt := Self.firstPkt; + while(pkt <> nil) do + begin + pkt1 := pkt^.next; + av_free_packet(@pkt^.pkt); + // Note: param must be a pointer to a pointer! + av_freep(@pkt); + pkt := pkt1; + end; + Self.lastPkt := nil; + Self.firstPkt := nil; + Self.nbPackets := 0; + Self.size := 0; + + SDL_UnlockMutex(Self.mutex); end; diff --git a/Game/Code/Classes/UAudioInput_Bass.pas b/Game/Code/Classes/UAudioInput_Bass.pas index 75a5aee5..6d661258 100644 --- a/Game/Code/Classes/UAudioInput_Bass.pas +++ b/Game/Code/Classes/UAudioInput_Bass.pas @@ -1,287 +1,203 @@ -unit UAudioInput_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - SysUtils, - bass, - ULog, - UMusic; - -implementation - -uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; - -type - TAudioInput_Bass = class( TInterfacedObject, IAudioInput) - private - public - function GetName: String; - - {IAudioInput interface} - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); - end; - - TBassSoundCard = class(TGenericSoundCard) - RecordStream: HSTREAM; - end; - -var - singleton_AudioInputBass : IAudioInput; - - -function TAudioInput_Bass.GetName: String; -begin - result := 'BASS_Input'; -end; - -procedure TAudioInput_Bass.InitializeRecord; -var - device: integer; - Descr: string; - input: integer; - input2: integer; - InputName: PChar; - Flags: integer; - mic: array[0..15] of integer; - SC: integer; // soundcard - SCI: integer; // soundcard input - No: integer; - -function isDuplicate(Desc: String): Boolean; -var - I: Integer; -begin - Result := False; - //Check for Soundcard with same Description - For I := 0 to SC-1 do - begin - if (AudioInputProcessor.SoundCard[I].Description = Desc) then - begin - Result := True; - Break; - end; - end; -end; - -begin - with AudioInputProcessor do - begin - // checks for recording devices and puts them into an array - SetLength(SoundCard, 0); - - SC := 0; - Descr := BASS_RecordGetDeviceDescription(SC); - - while (Descr <> '') do - begin - //If there is another SoundCard with the Same ID, Search an available Name - if (IsDuplicate(Descr)) then - begin - No:= 1; //Count of SoundCards with same Name - Repeat - Inc(No) - Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')'); - - //Set Description - Descr := Descr + ' (' + InttoStr(No) + ')'; - end; - - SetLength(SoundCard, SC+1); - - // TODO: free object on termination - SoundCard[SC] := TBassSoundCard.Create(); - SoundCard[SC].Description := Descr; - - //Get Recording Inputs - SCI := 0; - BASS_RecordInit(SC); - - InputName := BASS_RecordGetInputName(SCI); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty - // InputName. So, we have to add a hard coded - // Workaround for this problem - if (InputName = nil) and (Pos( 'USBMIC Serial#', Descr) > 0) then - begin - InputName := 'Microphone'; - end; - {$ENDIF} - - SetLength(SoundCard[SC].Input, 1); - SoundCard[SC].Input[SCI].Name := InputName; - - // process each input - while (InputName <> nil) do - begin - Flags := BASS_RecordGetInput(SCI); - if (SCI >= 1) {AND (Flags AND BASS_INPUT_OFF = 0)} then - begin - SetLength(SoundCard[SC].Input, SCI+1); - SoundCard[SC].Input[SCI].Name := InputName; - end; - - //Set Mic Index - if ((Flags and BASS_INPUT_TYPE_MIC) = 1) then - SoundCard[SC].MicInput := SCI; - - Inc(SCI); - InputName := BASS_RecordGetInputName(SCI); - end; - - BASS_RecordFree; - - Inc(SC); - Descr := BASS_RecordGetDeviceDescription(SC); - end; // while - end; // with Recording -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudioInput_Bass.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(AudioInputProcessor.Sound) do - AudioInputProcessor.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do - begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := AudioInputProcessor.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := AudioInputProcessor.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudioInput_Bass.CaptureStop; -var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; -begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); - end; - -end; - -{* - * Bass input capture callback. - * Params: - * stream - BASS input stream - * buffer - buffer of captured samples - * len - size of buffer in bytes - * user - players associated with left/right channels - *} -function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; - len: Cardinal; Card: Cardinal): boolean; stdcall; -begin - AudioInputProcessor.HandleMicrophoneData(buffer, len, AudioInputProcessor.SoundCard[Card]); - Result := true; -end; - -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in AudioInputProcessor.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudioInput_Bass.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: integer; - ErrorMsg: string; - bassSoundCard: TBassSoundCard; -begin - if not BASS_RecordInit(Card) then - begin - Error := BASS_ErrorGetCode; - ErrorMsg := IntToStr(Error); - if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5'; - if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized'; - if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid'; - if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver'; - Log.LogError('Error initializing record [' + IntToStr(Card) + ']'); - Log.LogError('TAudio_bass.CaptureCard: Error initializing record: ' + ErrorMsg); - end - else - begin - bassSoundCard := TBassSoundCard(AudioInputProcessor.SoundCard[Card]); - bassSoundCard.CaptureSoundLeft := CaptureSoundLeft; - bassSoundCard.CaptureSoundRight := CaptureSoundRight; - - // capture in 44.1kHz/stereo/16bit and a 20ms callback period - bassSoundCard.RecordStream := - BASS_RecordStart(44100, 2, MakeLong(0, 20) , @MicrophoneCallback, Card); - end; -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in AudioInputProcessor.SoundCard array - *} -procedure TAudioInput_Bass.StopCard(Card: byte); -begin - BASS_RecordSetDevice(Card); - BASS_RecordFree; -end; - - -initialization - singleton_AudioInputBass := TAudioInput_Bass.create(); - AudioManager.add( singleton_AudioInputBass ); - -finalization - AudioManager.Remove( singleton_AudioInputBass ); - -end. +unit UAudioInput_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + URecord, + UMusic; + +implementation + +uses + UMain, + UIni, + ULog, + UAudioCore_Bass, + Windows, + bass; + +type + TAudioInput_Bass = class(TAudioInputBase) + public + function GetName: String; override; + function InitializeRecord: boolean; override; + destructor Destroy; override; + end; + + TBassInputDevice = class(TAudioInputDevice) + public + DeviceIndex: integer; // index in TAudioInputProcessor.Device[] + BassDeviceID: integer; // DeviceID used by BASS + RecordStream: HSTREAM; + + procedure Start(); override; + procedure Stop(); override; + end; + +var + singleton_AudioInputBass : IAudioInput; + + +{ Global } + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; Card: Cardinal): boolean; stdcall; +begin + AudioInputProcessor.HandleMicrophoneData(buffer, len, + AudioInputProcessor.Device[Card]); + Result := true; +end; + + +{ TBassInputDevice } + +{* + * Start input-capturing on this device. + * TODO: call BASS_RecordInit only once + *} +procedure TBassInputDevice.Start(); +const + captureFreq = 44100; +begin + // recording already started -> stop first + if (RecordStream <> 0) then + Stop(); + + // TODO: Call once. Otherwise it's to slow + if not BASS_RecordInit(BassDeviceID) then + begin + Log.LogError('TBassInputDevice.Start: Error initializing device['+IntToStr(DeviceIndex)+']: ' + + TAudioCore_Bass.ErrorGetString()); + Exit; + end; + + SampleRate := captureFreq; + + // capture in 44.1kHz/stereo/16bit and a 20ms callback period + RecordStream := BASS_RecordStart(captureFreq, 2, MakeLong(0, 20), + @MicrophoneCallback, DeviceIndex); + if (RecordStream = 0) then + begin + BASS_RecordFree; + Exit; + end; +end; + +{* + * Stop input-capturing on this device. + *} +procedure TBassInputDevice.Stop(); +begin + if (RecordStream = 0) then + Exit; + // TODO: Don't free the device. Do this on close + if (BASS_RecordSetDevice(BassDeviceID)) then + BASS_RecordFree; + RecordStream := 0; +end; + + +{ TAudioInput_Bass } + +function TAudioInput_Bass.GetName: String; +begin + result := 'BASS_Input'; +end; + +function TAudioInput_Bass.InitializeRecord(): boolean; +var + Descr: PChar; + SourceName: PChar; + Flags: integer; + BassDeviceID: integer; + BassDevice: TBassInputDevice; + DeviceIndex: integer; + SourceIndex: integer; +begin + result := false; + + DeviceIndex := 0; + BassDeviceID := 0; + SetLength(AudioInputProcessor.Device, 0); + + // checks for recording devices and puts them into an array + while true do + begin + Descr := BASS_RecordGetDeviceDescription(BassDeviceID); + if (Descr = nil) then + break; + + SetLength(AudioInputProcessor.Device, DeviceIndex+1); + + // TODO: free object on termination + BassDevice := TBassInputDevice.Create(); + AudioInputProcessor.Device[DeviceIndex] := BassDevice; + + BassDevice.DeviceIndex := DeviceIndex; + BassDevice.BassDeviceID := BassDeviceID; + BassDevice.Description := UnifyDeviceName(Descr, DeviceIndex); + + // get input sources + SourceIndex := 0; + BASS_RecordInit(BassDeviceID); + BassDevice.MicInput := 0; + + // process each input + while true do + begin + SourceName := BASS_RecordGetInputName(SourceIndex); + if (SourceName = nil) then + break; + + SetLength(BassDevice.Source, SourceIndex+1); + BassDevice.Source[SourceIndex].Name := + UnifyDeviceSourceName(SourceName, BassDevice.Description); + + // set mic index + Flags := BASS_RecordGetInput(SourceIndex); + if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then + BassDevice.MicInput := SourceIndex; + + Inc(SourceIndex); + end; + + BASS_RecordFree; + + Inc(DeviceIndex); + Inc(BassDeviceID); + end; + + result := true; +end; + +destructor TAudioInput_Bass.Destroy; +begin + inherited; +end; + + +initialization + singleton_AudioInputBass := TAudioInput_Bass.create(); + AudioManager.add( singleton_AudioInputBass ); + +finalization + AudioManager.Remove( singleton_AudioInputBass ); + +end. diff --git a/Game/Code/Classes/UAudioInput_Portaudio.pas b/Game/Code/Classes/UAudioInput_Portaudio.pas index 8073a7f3..c969a1b3 100644 --- a/Game/Code/Classes/UAudioInput_Portaudio.pas +++ b/Game/Code/Classes/UAudioInput_Portaudio.pas @@ -6,60 +6,43 @@ interface {$MODE Delphi} {$ENDIF} -{$I switches.inc} +{$I ../switches.inc} -uses Classes, - SysUtils, - portaudio, - {$IFDEF UsePortmixer} - portmixer, - {$ENDIF} - ULog, - UMusic; +uses + Classes, + SysUtils, + UMusic; implementation uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; -{ -type - TPaHostApiIndex = PaHostApiIndex; - TPaDeviceIndex = PaDeviceIndex; - PPaStream = ^PaStreamPtr; - PPaStreamCallbackTimeInfo = ^PaStreamCallbackTimeInfo; - TPaStreamCallbackFlags = PaStreamCallbackFlags; - TPaHostApiTypeId = PaHostApiTypeId; - PPaHostApiInfo = ^PaHostApiInfo; - PPaDeviceInfo = ^PaDeviceInfo; - TPaError = PaError; - TPaStreamParameters = PaStreamParameters; -} + URecord, + UIni, + ULog, + UMain, + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + portaudio; + type - TAudioInput_Portaudio = class( TInterfacedObject, IAudioInput ) + TAudioInput_Portaudio = class(TAudioInputBase) private function GetPreferredApiIndex(): TPaHostApiIndex; public - function GetName: String; - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - - procedure CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); - procedure StopCard(Card: byte); + function GetName: String; override; + function InitializeRecord: boolean; override; + destructor Destroy; override; end; - TPortaudioSoundCard = class(TGenericSoundCard) - RecordStream: PPaStream; - DeviceIndex: TPaDeviceIndex; + TPortaudioInputDevice = class(TAudioInputDevice) + public + RecordStream: PPaStream; + PaDeviceIndex: TPaDeviceIndex; + + procedure Start(); override; + procedure Stop(); override; end; function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; @@ -69,9 +52,6 @@ function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longwor var singleton_AudioInputPortaudio : IAudioInput; -const - sampleRate: Double = 44100.; - {* the default API used by Portaudio is the least common denominator * and might lack efficiency. ApiPreferenceOrder defines the order of * preferred APIs to use. The first API-type in the list is tried first. If it's @@ -102,6 +82,62 @@ var array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); {$IFEND} + +{ TPortaudioInputDevice } + +procedure TPortaudioInputDevice.Start(); +var + Error: TPaError; + ErrorMsg: string; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; +begin + // get input latency info + deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); + + // set input stream parameters + with inputParams do begin + device := PaDeviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + Log.LogStatus(inttostr(PaDeviceIndex), 'Portaudio'); + Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(RecordStream, @inputParams, nil, SampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(Self)); + if(Error <> paNoError) then begin + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TPortaudioInputDevice.Start(): Error opening stream: ' + ErrorMsg); + //Halt; + end; + + // start capture + Error := Pa_StartStream(RecordStream); + if(Error <> paNoError) then begin + Pa_CloseStream(RecordStream); + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TPortaudioInputDevice.Start(): Error starting stream: ' + ErrorMsg); + //Halt; + end; +end; + +procedure TPortaudioInputDevice.Stop(); +begin + if assigned(RecordStream) then begin + Pa_StopStream(RecordStream); + Pa_CloseStream(RecordStream); + end; +end; + + +{ TAudioInput_Portaudio } + function TAudioInput_Portaudio.GetName: String; begin result := 'Portaudio'; @@ -130,8 +166,7 @@ begin end; end; -// TODO: should be a function with boolean return type -procedure TAudioInput_Portaudio.InitializeRecord; +function TAudioInput_Portaudio.InitializeRecord(): boolean; var i: integer; apiIndex: TPaHostApiIndex; @@ -139,37 +174,42 @@ var deviceName: string; deviceIndex: TPaDeviceIndex; deviceInfo: PPaDeviceInfo; - inputCnt: integer; - inputName: string; + sourceCnt: integer; + sourceName: string; SC: integer; // soundcard - SCI: integer; // soundcard input + SCI: integer; // soundcard source err: TPaError; errMsg: string; - paSoundCard: TPortaudioSoundCard; + paDevice: TPortaudioInputDevice; inputParams: TPaStreamParameters; stream: PPaStream; {$IFDEF UsePortmixer} mixer: PPxMixer; {$ENDIF} +const + captureFreq = 44100; begin - // TODO: call Pa_Terminate() on termination + result := false; + + writeln('0'); + err := Pa_Initialize(); if(err <> paNoError) then begin - Log.CriticalError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - //Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); - // result := false; + Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); Exit; end; - + writeln('1'); apiIndex := GetPreferredApiIndex(); apiInfo := Pa_GetHostApiInfo(apiIndex); SC := 0; + writeln('2'); // init array-size to max. input-devices count - SetLength(AudioInputProcessor.SoundCard, apiInfo^.deviceCount); // fix deviceCountL - for i:= 0 to High(AudioInputProcessor.SoundCard) do + SetLength(AudioInputProcessor.Device, apiInfo^.deviceCount); + for i:= 0 to High(AudioInputProcessor.Device) do begin + writeln('25'); // convert API-specific device-index to global index deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); deviceInfo := Pa_GetDeviceInfo(deviceIndex); @@ -178,14 +218,13 @@ begin if(deviceInfo^.maxInputChannels <= 0) then continue; - // TODO: free object on termination - paSoundCard := TPortaudioSoundCard.Create(); - AudioInputProcessor.SoundCard[SC] := paSoundCard; + paDevice := TPortaudioInputDevice.Create(); + AudioInputProcessor.Device[SC] := paDevice; // retrieve device-name deviceName := deviceInfo^.name; - paSoundCard.Description := deviceName; - paSoundCard.DeviceIndex := deviceIndex; + paDevice.Description := deviceName; + paDevice.PaDeviceIndex := deviceIndex; // setup desired input parameters with inputParams do begin @@ -196,29 +235,32 @@ begin hostApiSpecificStreamInfo := nil; end; + paDevice.SampleRate := captureFreq; + // check if device supports our input-format - err := Pa_IsFormatSupported(@inputParams, nil, sampleRate); + err := Pa_IsFormatSupported(@inputParams, nil, paDevice.SampleRate); if(err <> 0) then begin // format not supported -> skip errMsg := Pa_GetErrorText(err); Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + '('+ errMsg +')'); - paSoundCard.Free(); + paDevice.Free(); continue; end; // TODO: retry with mono if stereo is not supported // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might // not be set correctly in OSS) + // use TPaDeviceInfo.defaultSampleRate - err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + err := Pa_OpenStream(stream, @inputParams, nil, paDevice.SampleRate, paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); if(err <> paNoError) then begin // unable to open device -> skip errMsg := Pa_GetErrorText(err); Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + '('+ errMsg +')'); - paSoundCard.Free(); + paDevice.Free(); continue; end; @@ -229,14 +271,14 @@ begin mixer := Px_OpenMixer(stream, 0); // get input count - inputCnt := Px_GetNumInputSources(mixer); - SetLength(paSoundCard.Input, inputCnt); + sourceCnt := Px_GetNumInputSources(mixer); + SetLength(paDevice.Source, sourceCnt); // get input names - for SCI := 0 to inputCnt-1 do + for SCI := 0 to sourceCnt-1 do begin - inputName := Px_GetInputSourceName(mixer, SCI); - paSoundCard.Input[SCI].Name := inputName; + sourceName := Px_GetInputSourceName(mixer, SCI); + paDevice.Source[SCI].Name := sourceName; end; Px_CloseMixer(mixer); @@ -247,80 +289,46 @@ begin // TODO: check if callback was called (this problem may occur on some devices) //Pa_StopStream(stream); - Pa_CloseStream(stream); - // create a standard input source - SetLength(paSoundCard.Input, 1); - paSoundCard.Input[0].Name := 'Standard'; + SetLength(paDevice.Source, 1); + paDevice.Source[0].Name := 'Standard'; {$ENDIF} + // close test-stream + Pa_CloseStream(stream); + // use default input source - paSoundCard.InputSelected := 0; + paDevice.SourceSelected := 0; Inc(SC); end; + writeln('3'); // adjust size to actual input-device count - SetLength(AudioInputProcessor.SoundCard, SC); + SetLength(AudioInputProcessor.Device, SC); Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); { SoundCard[SC].InputSelected := Mic[Device]; } + result := true; end; -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudioInput_Portaudio.CaptureStart; -var - S: integer; - SC: integer; - PlayerLeft, PlayerRight: integer; - CaptureSoundLeft, CaptureSoundRight: TSound; -begin - for S := 0 to High(AudioInputProcessor.Sound) do - AudioInputProcessor.Sound[S].BufferLong[0].Clear; - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then begin - if (PlayerLeft > -1) then - CaptureSoundLeft := AudioInputProcessor.Sound[PlayerLeft] - else - CaptureSoundLeft := nil; - if (PlayerRight > -1) then - CaptureSoundRight := AudioInputProcessor.Sound[PlayerRight] - else - CaptureSoundRight := nil; - - CaptureCard(SC, CaptureSoundLeft, CaptureSoundRight); - end; - end; -end; - -// TODO: code is used by all IAudioInput implementors -// -> move to a common superclass (TAudioInput_Generic?) -procedure TAudioInput_Portaudio.CaptureStop; +destructor TAudioInput_Portaudio.Destroy; var - SC: integer; - PlayerLeft: integer; - PlayerRight: integer; + i: integer; + paSoundCard: TPortaudioInputDevice; begin - - for SC := 0 to High(Ini.CardList) do begin - PlayerLeft := Ini.CardList[SC].ChannelL-1; - PlayerRight := Ini.CardList[SC].ChannelR-1; - if PlayerLeft >= PlayersPlay then PlayerLeft := -1; - if PlayerRight >= PlayersPlay then PlayerRight := -1; - if (PlayerLeft > -1) or (PlayerRight > -1) then - StopCard(SC); + Pa_Terminate(); + for i := 0 to High(AudioInputProcessor.Device) do + begin + AudioInputProcessor.Device[i].Free(); end; + AudioInputProcessor.Device := nil; + inherited Destroy; end; {* @@ -334,81 +342,6 @@ begin result := paContinue; end; -{* - * Start input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - * CaptureSoundLeft - sound(-buffer) used for left channel capture data - * CaptureSoundRight - sound(-buffer) used for right channel capture data - *} -procedure TAudioInput_Portaudio.CaptureCard(Card: byte; CaptureSoundLeft, CaptureSoundRight: TSound); -var - Error: TPaError; - ErrorMsg: string; - inputParams: TPaStreamParameters; - deviceInfo: PPaDeviceInfo; - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - paSoundCard := TPortaudioSoundCard(AudioInputProcessor.SoundCard[Card]); - paSoundCard.CaptureSoundLeft := CaptureSoundLeft; - paSoundCard.CaptureSoundRight := CaptureSoundRight; - - // get input latency info - deviceInfo := Pa_GetDeviceInfo(paSoundCard.DeviceIndex); - - // set input stream parameters - with inputParams do begin - device := paSoundCard.DeviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - Log.LogStatus(inttostr(paSoundCard.DeviceIndex), 'Portaudio'); - Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); - - // open input stream - Error := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, - @MicrophoneCallback, Pointer(paSoundCard)); - if(Error <> paNoError) then begin - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error opening stream: ' + ErrorMsg); - //Halt; - end; - - paSoundCard.RecordStream := stream; - - // start capture - Error := Pa_StartStream(stream); - if(Error <> paNoError) then begin - Pa_CloseStream(stream); - ErrorMsg := Pa_GetErrorText(Error); - Log.CriticalError('TAudio_Portaudio.CaptureCard('+ IntToStr(Card) +'): Error starting stream: ' + ErrorMsg); - //Halt; - end; -end; - -{* - * Stop input-capturing on Soundcard specified by Card. - * Params: - * Card - soundcard index in Recording.SoundCard array - *} -procedure TAudioInput_Portaudio.StopCard(Card: byte); -var - stream: PPaStream; - paSoundCard: TPortaudioSoundCard; -begin - paSoundCard := TPortaudioSoundCard(AudioInputProcessor.SoundCard[Card]); - stream := paSoundCard.RecordStream; - if(stream <> nil) then begin - Pa_StopStream(stream); - Pa_CloseStream(stream); - end; -end; - initialization singleton_AudioInputPortaudio := TAudioInput_Portaudio.create(); diff --git a/Game/Code/Classes/UAudioPlayback_Bass.pas b/Game/Code/Classes/UAudioPlayback_Bass.pas index 87ff183d..266a5ec3 100644 --- a/Game/Code/Classes/UAudioPlayback_Bass.pas +++ b/Game/Code/Classes/UAudioPlayback_Bass.pas @@ -9,35 +9,31 @@ interface {$I switches.inc} -uses Classes, - {$IFDEF win32} - windows, - {$ENDIF} - SysUtils, - bass, - ULog, - UMusic; +uses + Classes, + SysUtils, + UMusic; implementation uses - {$IFDEF LAZARUS} - lclintf, - {$ENDIF} - URecord, - UIni, - UMain, - UCommon, - UThemes; + UIni, + UMain, + ULog, + UAudioCore_Bass, + bass; type - TBassOutputStream = class(TAudioPlaybackStream) + TBassPlaybackStream = class(TAudioPlaybackStream) private Handle: HSTREAM; + Loop: boolean; public constructor Create(); overload; constructor Create(stream: HSTREAM); overload; + procedure Reset(); + procedure Play(); override; procedure Pause(); override; procedure Stop(); override; @@ -46,41 +42,33 @@ type procedure SetLoop(Enabled: boolean); override; function GetLength(): real; override; function GetStatus(): TStreamStatus; override; + function GetVolume(): integer; override; + procedure SetVolume(volume: integer); override; + + function GetPosition: real; + procedure SetPosition(Time: real); + + function IsLoaded(): boolean; end; type TAudioPlayback_Bass = class( TInterfacedObject, IAudioPlayback) private - MusicStream: HSTREAM; - - StartSoundStream: HSTREAM; - BackSoundStream: HSTREAM; - SwooshSoundStream: HSTREAM; - ChangeSoundStream: HSTREAM; - OptionSoundStream: HSTREAM; - ClickSoundStream: HSTREAM; - DrumSoundStream: HSTREAM; - HihatSoundStream: HSTREAM; - ClapSoundStream: HSTREAM; - ShuffleSoundStream: HSTREAM; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - Loaded: boolean; - Loop: boolean; + MusicStream: TBassPlaybackStream; + function Load(Filename: string): TBassPlaybackStream; public function GetName: String; {IAudioOutput interface} - procedure InitializePlayback; + function InitializePlayback(): boolean; procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); - function Open(Name: string): boolean; // true if succeed - + function Open(Filename: string): boolean; // true if succeed + procedure Rewind; procedure Play; procedure Pause; //Pause Mod @@ -91,79 +79,106 @@ type function GetPosition: real; procedure SetPosition(Time: real); - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; - //Equalizer - function GetFFTData: TFFTData; + procedure GetFFTData(var data: TFFTData); // Interface for Visualizer function GetPCMData(var data: TPCMData): Cardinal; - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); + // Sounds + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); end; var singleton_AudioPlaybackBass : IAudioPlayback; -constructor TBassOutputStream.Create(); +constructor TBassPlaybackStream.Create(); begin inherited; + Reset(); end; -constructor TBassOutputStream.Create(stream: HSTREAM); +constructor TBassPlaybackStream.Create(stream: HSTREAM); begin Create(); Handle := stream; end; -procedure TBassOutputStream.Play(); +procedure TBassPlaybackStream.Reset(); +begin + Loop := false; + if (Handle <> 0) then + Bass_StreamFree(Handle); + Handle := 0; +end; + +procedure TBassPlaybackStream.Play(); begin - BASS_ChannelPlay(Handle, True); + BASS_ChannelPlay(Handle, Loop); end; -procedure TBassOutputStream.Pause(); +procedure TBassPlaybackStream.Pause(); begin - //if (Loaded) then BASS_ChannelPause(Handle); end; -procedure TBassOutputStream.Stop(); +procedure TBassPlaybackStream.Stop(); begin BASS_ChannelStop(Handle); end; -procedure TBassOutputStream.Close(); +procedure TBassPlaybackStream.Close(); begin - Bass_StreamFree(Handle); + Reset(); end; -function TBassOutputStream.GetLoop(): boolean; +function TBassPlaybackStream.GetVolume(): integer; begin - // TODO - result := false; + Result := 0; + BASS_ChannelSetAttributes(Handle, PInteger(nil)^, Result, PInteger(nil)^); +end; + +procedure TBassPlaybackStream.SetVolume(volume: integer); +begin + // clamp volume + if volume < 0 then + volume := 0; + if volume > 100 then + volume := 100; + // set volume + BASS_ChannelSetAttributes(Handle, -1, volume, -101); end; -procedure TBassOutputStream.SetLoop(Enabled: boolean); +function TBassPlaybackStream.GetPosition: real; +var + bytes: integer; +begin + bytes := BASS_ChannelGetPosition(Handle); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +procedure TBassPlaybackStream.SetPosition(Time: real); +var + bytes: integer; begin - // TODO + bytes := BASS_ChannelSeconds2Bytes(Handle, Time); + BASS_ChannelSetPosition(Handle, bytes); end; -function TBassOutputStream.GetLength(): real; +function TBassPlaybackStream.GetLoop(): boolean; +begin + result := Loop; +end; + +procedure TBassPlaybackStream.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TBassPlaybackStream.GetLength(): real; var bytes: integer; begin @@ -171,37 +186,45 @@ begin Result := BASS_ChannelBytes2Seconds(Handle, bytes); end; -function TBassOutputStream.GetStatus(): TStreamStatus; +function TBassPlaybackStream.GetStatus(): TStreamStatus; var state: DWORD; begin state := BASS_ChannelIsActive(Handle); case state of BASS_ACTIVE_PLAYING: - result := sPlaying; + result := ssPlaying; BASS_ACTIVE_PAUSED: - result := sPaused; + result := ssPaused; + BASS_ACTIVE_STALLED: + result := ssBlocked; + BASS_ACTIVE_STOPPED: + result := ssStopped; else - result := sStopped; + result := ssUnknown; end; end; +function TBassPlaybackStream.IsLoaded(): boolean; +begin + Result := (Handle <> 0); +end; + function TAudioPlayback_Bass.GetName: String; begin result := 'BASS_Playback'; end; -procedure TAudioPlayback_Bass.InitializePlayback; +function TAudioPlayback_Bass.InitializePlayback(): boolean; var Pet: integer; S: integer; begin -// Log.BenchmarkStart(4); -// Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + result := false; - Loaded := false; - Loop := false; + //Log.BenchmarkStart(4); + //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); if not BASS_Init(1, 44100, 0, 0, nil) then begin @@ -209,30 +232,32 @@ begin Exit; end; -// Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); // config playing buffer -// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); -// BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - -// Log.LogStatus('Loading Sounds', 'Music Initialize'); + //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); + //BASS_SetConfig(BASS_CONFIG_BUFFER, 100); -// Log.BenchmarkStart(4); - LoadSoundFromFile(StartSoundStream, SoundPath + 'Common Start.mp3'); - LoadSoundFromFile(BackSoundStream, SoundPath + 'Common Back.mp3'); - LoadSoundFromFile(SwooshSoundStream, SoundPath + 'menu swoosh.mp3'); - LoadSoundFromFile(ChangeSoundStream, SoundPath + 'select music change music 50.mp3'); - LoadSoundFromFile(OptionSoundStream, SoundPath + 'option change col.mp3'); - LoadSoundFromFile(ClickSoundStream, SoundPath + 'rimshot022b.mp3'); + result := true; +end; -// LoadSoundFromFile(DrumSoundStream, SoundPath + 'bassdrumhard076b.mp3'); -// LoadSoundFromFile(HihatSoundStream, SoundPath + 'hihatclosed068b.mp3'); -// LoadSoundFromFile(ClapSoundStream, SoundPath + 'claps050b.mp3'); +function TAudioPlayback_Bass.Load(Filename: string): TBassPlaybackStream; +var + L: Integer; + stream: HSTREAM; +begin + Result := nil; -// LoadSoundFromFile(ShuffleSoundStream, SoundPath + 'Shuffle.mp3'); + //Log.LogStatus('Loading Sound: "' + Filename + '"', 'LoadSoundFromFile'); + stream := BASS_StreamCreateFile(False, pchar(Filename), 0, 0, 0); + if (stream = 0) then + begin + Log.LogError('Failed to open "' + Filename + '", ' + + TAudioCore_Bass.ErrorGetString(BASS_ErrorGetCode()), 'TAudioPlayback_Bass.Load'); + Exit; + end; -// Log.BenchmarkEnd(4); -// Log.LogBenchmark('--> Loading Sounds', 4); + Result := TBassPlaybackStream.Create(stream); end; procedure TAudioPlayback_Bass.SetVolume(Volume: integer); @@ -240,7 +265,6 @@ begin //Old Sets Wave Volume //BASS_SetVolume(Volume); //New: Sets Volume only for this Application - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); @@ -248,193 +272,102 @@ end; procedure TAudioPlayback_Bass.SetMusicVolume(Volume: Integer); begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; - - if Volume < 0 then - Volume := 0; - - //Set Volume - BASS_ChannelSetAttributes (MusicStream, -1, Volume, -101); + if assigned(MusicStream) then + MusicStream.SetVolume(Volume); end; procedure TAudioPlayback_Bass.SetLoop(Enabled: boolean); begin - Loop := Enabled; + if assigned(MusicStream) then + MusicStream.Loop := Enabled; end; -function TAudioPlayback_Bass.Open(Name: string): boolean; +function TAudioPlayback_Bass.Open(Filename: string): boolean; +var + stream: HSTREAM; begin - Loaded := false; - if FileExists(Name) then - begin - MusicStream := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0); + Result := false; - Loaded := true; - //Set Max Volume - SetMusicVolume (100); - end; + // free old MusicStream + if assigned(MusicStream) then + MusicStream.Free; - Result := Loaded; -end; + MusicStream := Load(Filename); + if not assigned(MusicStream) then + Exit; -procedure TAudioPlayback_Bass.Rewind; -begin - if Loaded then begin - end; + //Set Max Volume + SetMusicVolume(100); + + Result := true; end; -procedure TAudioPlayback_Bass.SetPosition(Time: real); -var - bytes: integer; +procedure TAudioPlayback_Bass.Rewind; begin - bytes := BASS_ChannelSeconds2Bytes(MusicStream, Time); - BASS_ChannelSetPosition(MusicStream, bytes); + SetPosition(0); end; procedure TAudioPlayback_Bass.Play; begin - if Loaded then - begin - if Loop then - BASS_ChannelPlay(MusicStream, True); // start from beginning... actually bass itself does not loop, nor does this TAudio_bass Class - - BASS_ChannelPlay(MusicStream, False); // for setting position before playing - end; + if assigned(MusicStream) then + MusicStream.Play(); end; -procedure TAudioPlayback_Bass.Pause; //Pause Mod +procedure TAudioPlayback_Bass.Pause; begin - if Loaded then begin - BASS_ChannelPause(MusicStream); // Pauses Song - end; + if assigned(MusicStream) then + MusicStream.Pause(); end; procedure TAudioPlayback_Bass.Stop; begin - Bass_ChannelStop(MusicStream); + if assigned(MusicStream) then + MusicStream.Stop(); end; procedure TAudioPlayback_Bass.Close; begin - Bass_StreamFree(MusicStream); + if assigned(MusicStream) then + MusicStream.Close(); end; function TAudioPlayback_Bass.Length: real; var bytes: integer; begin - bytes := BASS_ChannelGetLength(MusicStream); - Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); -end; - -function TAudioPlayback_Bass.getPosition: real; -var - bytes: integer; -begin - bytes := BASS_ChannelGetPosition(MusicStream); - Result := BASS_ChannelBytes2Seconds(MusicStream, bytes); -end; - -function TAudioPlayback_Bass.Finished: boolean; -begin - Result := false; - - if BASS_ChannelIsActive(MusicStream) = BASS_ACTIVE_STOPPED then - begin - Result := true; - end; -end; - -procedure TAudioPlayback_Bass.PlayStart; -begin - BASS_ChannelPlay(StartSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayBack; -begin - BASS_ChannelPlay(BackSoundStream, True);// then -end; - -procedure TAudioPlayback_Bass.PlaySwoosh; -begin - BASS_ChannelPlay(SwooshSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayChange; -begin - BASS_ChannelPlay(ChangeSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayOption; -begin - BASS_ChannelPlay(OptionSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayClick; -begin - BASS_ChannelPlay(ClickSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayDrum; -begin - BASS_ChannelPlay(DrumSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayHihat; -begin - BASS_ChannelPlay(HihatSoundStream, True); -end; - -procedure TAudioPlayback_Bass.PlayClap; -begin - BASS_ChannelPlay(ClapSoundStream, True); + if assigned(MusicStream) then + Result := MusicStream.GetLength() + else + Result := -1; end; -procedure TAudioPlayback_Bass.PlayShuffle; +function TAudioPlayback_Bass.GetPosition: real; begin - BASS_ChannelPlay(ShuffleSoundStream, True); + if assigned(MusicStream) then + Result := MusicStream.GetPosition() + else + Result := -1; end; -procedure TAudioPlayback_Bass.StopShuffle; +procedure TAudioPlayback_Bass.SetPosition(Time: real); begin - BASS_ChannelStop(ShuffleSoundStream); + if assigned(MusicStream) then + MusicStream.SetPosition(Time); end; -function TAudioPlayback_Bass.LoadSoundFromFile(var stream: HSTREAM; Name: string): boolean; -var - L: Integer; +function TAudioPlayback_Bass.Finished: boolean; begin - if FileExists(Name) then - begin - Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); - try - stream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0); - - //Add CustomSound - L := High(CustomSounds) + 1; - SetLength (CustomSounds, L + 1); - CustomSounds[L].Filename := Name; - CustomSounds[L].Stream := TBassOutputStream.Create(stream); - except - Log.LogError('Failed to open using BASS', 'LoadSoundFromFile'); - end; - end + if assigned(MusicStream) then + Result := (MusicStream.GetStatus() = ssStopped) else - begin - Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile'); - exit; - end; + Result := true; end; //Equalizer -function TAudioPlayback_Bass.GetFFTData: TFFTData; -var - Data: TFFTData; +procedure TAudioPlayback_Bass.GetFFTData(var data: TFFTData); begin //Get Channel Data Mono and 256 Values - BASS_ChannelGetData(MusicStream, @Result, BASS_DATA_FFT512); + BASS_ChannelGetData(MusicStream.Handle, @data, BASS_DATA_FFT512); end; {* @@ -447,23 +380,21 @@ var nBytes: DWORD; begin //Get Channel Data Mono and 256 Values - BASS_ChannelGetInfo(MusicStream, info); - ZeroMemory(@data, sizeof(TPCMData)); + BASS_ChannelGetInfo(MusicStream.Handle, info); + FillChar(data, sizeof(TPCMData), 0); if (info.chans = 1) then begin // mono file -> add stereo channel - { - nBytes := BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); + nBytes := 0;//BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); // interleave data //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); - } result := 0; end else begin // stereo file - nBytes := BASS_ChannelGetData(MusicStream, @data, sizeof(TPCMData)); + nBytes := BASS_ChannelGetData(MusicStream.Handle, @data, sizeof(TPCMData)); end; if(nBytes <= 0) then result := 0 @@ -471,36 +402,21 @@ begin result := nBytes div sizeof(TPCMStereoSample); end; -function TAudioPlayback_Bass.LoadCustomSound(const Filename: String): Cardinal; -var - S: hStream; - I: Integer; - F: String; +function TAudioPlayback_Bass.OpenSound(const Filename: string): TAudioPlaybackStream; begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; + result := Load(Filename); +end; - if LoadSoundFromFile(S, SoundPath + Filename) then - Result := High(CustomSounds) - else - Result := 0; +procedure TAudioPlayback_Bass.PlaySound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Play(); end; -procedure TAudioPlayback_Bass.PlayCustomSound(const Index: Cardinal ); +procedure TAudioPlayback_Bass.StopSound(stream: TAudioPlaybackStream); begin - if Index <= High(CustomSounds) then - with CustomSounds[Index].Stream as TBassOutputStream do - begin - BASS_ChannelPlay(Handle, True); - end; + if assigned(stream) then + stream.Stop(); end; diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index 5f4a8cde..2743fa86 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -9,35 +9,40 @@ interface {$I switches.inc} -uses Classes, - SysUtils, - UMusic; +uses + Classes, + SysUtils, + UMusic; implementation uses - {$IFDEF LAZARUS} - lclintf, - {$ifndef win32} - libc, - {$endif} - {$ENDIF} - sdl, - portaudio, - ULog, - UIni, - UMain; + {$IFNDEF Win32} + libc, + {$ENDIF} + sdl, + portaudio, + ULog, + UIni, + UMain; type TPortaudioPlaybackStream = class(TAudioPlaybackStream) private - status: TStreamStatus; - Loaded: boolean; + Status: TStreamStatus; Loop: boolean; + + _volume: integer; + + procedure Reset(); public - decodeStream: TAudioDecodeStream; + DecodeStream: TAudioDecodeStream; + + constructor Create(); + destructor Destroy(); override; + + function SetDecodeStream(decodeStream: TAudioDecodeStream): boolean; - constructor Create(decodeStream: TAudioDecodeStream); procedure Play(); override; procedure Pause(); override; procedure Stop(); override; @@ -49,6 +54,9 @@ type function IsLoaded(): boolean; + function GetVolume(): integer; override; + procedure SetVolume(volume: integer); override; + // functions delegated to the decode stream function GetPosition: real; procedure SetPosition(Time: real); @@ -60,12 +68,23 @@ type private activeStreams: TList; mixerBuffer: PChar; + internalLock: PSDL_Mutex; + + _volume: integer; + + procedure Lock(); inline; + procedure Unlock(); inline; + + function GetVolume(): integer; + procedure SetVolume(volume: integer); public constructor Create(); destructor Destroy(); override; procedure AddStream(stream: TAudioPlaybackStream); procedure RemoveStream(stream: TAudioPlaybackStream); function ReadData(Buffer: PChar; BufSize: integer): integer; + + property Volume: integer READ GetVolume WRITE SetVolume; end; type @@ -73,36 +92,29 @@ type private MusicStream: TPortaudioPlaybackStream; - StartSoundStream: TPortaudioPlaybackStream; - BackSoundStream: TPortaudioPlaybackStream; - SwooshSoundStream: TPortaudioPlaybackStream; - ChangeSoundStream: TPortaudioPlaybackStream; - OptionSoundStream: TPortaudioPlaybackStream; - ClickSoundStream: TPortaudioPlaybackStream; - DrumSoundStream: TPortaudioPlaybackStream; - HihatSoundStream: TPortaudioPlaybackStream; - ClapSoundStream: TPortaudioPlaybackStream; - ShuffleSoundStream: TPortaudioPlaybackStream; - - //Custom Sounds - CustomSounds: array of TCustomSoundEntry; - - mixerStream: TAudioMixerStream; + MixerStream: TAudioMixerStream; paStream: PPaStream; - public - FrameSize: integer; - function GetName: String; + FrameSize: integer; function InitializePortaudio(): boolean; function StartPortaudioStream(): boolean; - procedure InitializePlayback(); + function InitializeSDLAudio(): boolean; + function StartSDLAudioStream(): boolean; + procedure StopSDLAudioStream(); + public + function GetName: String; + + function InitializePlayback(): boolean; + destructor Destroy; override; + + function Load(const Filename: String): TPortaudioPlaybackStream; + procedure SetVolume(Volume: integer); procedure SetMusicVolume(Volume: integer); procedure SetLoop(Enabled: boolean); function Open(Filename: string): boolean; // true if succeed - function Load(Filename: string): TPortaudioPlaybackStream; procedure Rewind; procedure SetPosition(Time: real); procedure Play; @@ -113,27 +125,17 @@ type function Finished: boolean; function Length: real; function GetPosition: real; - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - //Equalizer - function GetFFTData: TFFTData; + + // Equalizer + procedure GetFFTData(var data: TFFTData); // Interface for Visualizer function GetPCMData(var data: TPCMData): Cardinal; - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); + // Sounds + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); end; @@ -150,25 +152,59 @@ var constructor TAudioMixerStream.Create(); begin activeStreams := TList.Create; + internalLock := SDL_CreateMutex(); + _volume := 100; end; destructor TAudioMixerStream.Destroy(); begin - if (mixerBuffer <> nil) then + if assigned(mixerBuffer) then Freemem(mixerBuffer); activeStreams.Free; + SDL_DestroyMutex(internalLock); +end; + +procedure TAudioMixerStream.Lock(); +begin + SDL_mutexP(internalLock); +end; + +procedure TAudioMixerStream.Unlock(); +begin + SDL_mutexV(internalLock); +end; + +function TAudioMixerStream.GetVolume(): integer; +begin + Lock(); + result := _volume; + Unlock(); +end; + +procedure TAudioMixerStream.SetVolume(volume: integer); +begin + Lock(); + _volume := volume; + Unlock(); end; procedure TAudioMixerStream.AddStream(stream: TAudioPlaybackStream); begin + if not assigned(stream) then + Exit; + + Lock(); // check if stream is already in list to avoid duplicates if (activeStreams.IndexOf(Pointer(stream)) = -1) then activeStreams.Add(Pointer(stream)); + Unlock(); end; procedure TAudioMixerStream.RemoveStream(stream: TAudioPlaybackStream); begin + Lock(); activeStreams.Remove(Pointer(stream)); + Unlock(); end; function TAudioMixerStream.ReadData(Buffer: PChar; BufSize: integer): integer; @@ -176,79 +212,111 @@ var i: integer; size: integer; stream: TPortaudioPlaybackStream; + appVolume: single; begin result := BufSize; // zero target-buffer (silence) FillChar(Buffer^, BufSize, 0); - // resize mixer-buffer + // resize mixer-buffer if necessary ReallocMem(mixerBuffer, BufSize); - if (mixerBuffer = nil) then + if not assigned(mixerBuffer) then Exit; - writeln('Mix: ' + inttostr(activeStreams.Count)); + Lock(); + + //writeln('Mix: ' + inttostr(activeStreams.Count)); + + // use _volume instead of Volume to prevent recursive locking + appVolume := _volume / 100 * SDL_MIX_MAXVOLUME; for i := 0 to activeStreams.Count-1 do begin stream := TPortaudioPlaybackStream(activeStreams[i]); - if (stream.GetStatus() = sPlaying) then + if (stream.GetStatus() = ssPlaying) then begin // fetch data from current stream size := stream.ReadData(mixerBuffer, BufSize); if (size > 0) then begin - SDL_MixAudio(PUInt8(Buffer), PUInt8(mixerBuffer), size, SDL_MIX_MAXVOLUME); + SDL_MixAudio(PUInt8(Buffer), PUInt8(mixerBuffer), size, + Trunc(appVolume * stream.Volume / 100)); end; end; end; + + Unlock(); end; { TPortaudioPlaybackStream } -constructor TPortaudioPlaybackStream.Create(decodeStream: TAudioDecodeStream); +constructor TPortaudioPlaybackStream.Create(); begin inherited Create(); - status := sStopped; - if (decodeStream <> nil) then - begin - Self.decodeStream := decodeStream; - Loaded := true; - end; + Reset(); +end; + +destructor TPortaudioPlaybackStream.Destroy(); +begin + Close(); + inherited Destroy(); +end; + +procedure TPortaudioPlaybackStream.Reset(); +begin + Status := ssStopped; + Loop := false; + DecodeStream := nil; + _volume := 0; +end; + +function TPortaudioPlaybackStream.SetDecodeStream(decodeStream: TAudioDecodeStream): boolean; +begin + result := false; + + Reset(); + + if not assigned(decodeStream) then + Exit; + Self.DecodeStream := decodeStream; + + _volume := 100; + + result := true; +end; + +procedure TPortaudioPlaybackStream.Close(); +begin + Reset(); end; procedure TPortaudioPlaybackStream.Play(); begin - if (status <> sPaused) then + if (status <> ssPaused) then begin // rewind - decodeStream.Position := 0; + if assigned(DecodeStream) then + DecodeStream.Position := 0; end; - status := sPlaying; - //mixerStream.AddStream(Self); + status := ssPlaying; + //MixerStream.AddStream(Self); end; procedure TPortaudioPlaybackStream.Pause(); begin - status := sPaused; + status := ssPaused; end; procedure TPortaudioPlaybackStream.Stop(); begin - status := sStopped; -end; - -procedure TPortaudioPlaybackStream.Close(); -begin - status := sStopped; - Loaded := false; - // TODO: cleanup decode-stream + status := ssStopped; end; function TPortaudioPlaybackStream.IsLoaded(): boolean; begin - result := Loaded; + result := assigned(DecodeStream); end; function TPortaudioPlaybackStream.GetLoop(): boolean; @@ -263,7 +331,10 @@ end; function TPortaudioPlaybackStream.GetLength(): real; begin - result := decodeStream.Length; + if assigned(DecodeStream) then + result := DecodeStream.Length + else + result := -1; end; function TPortaudioPlaybackStream.GetStatus(): TStreamStatus; @@ -273,22 +344,47 @@ end; function TPortaudioPlaybackStream.ReadData(Buffer: PChar; BufSize: integer): integer; begin - result := decodeStream.ReadData(Buffer, BufSize); + if not assigned(DecodeStream) then + begin + result := -1; + Exit; + end; + result := DecodeStream.ReadData(Buffer, BufSize); // end-of-file reached -> stop playback - if (decodeStream.EOF) then + if (DecodeStream.EOF) then begin - status := sStopped; + status := ssStopped; end; end; function TPortaudioPlaybackStream.GetPosition: real; begin - result := decodeStream.Position; + if assigned(DecodeStream) then + result := DecodeStream.Position + else + result := -1; end; procedure TPortaudioPlaybackStream.SetPosition(Time: real); begin - decodeStream.Position := Time; + if assigned(DecodeStream) then + DecodeStream.Position := Time; +end; + +function TPortaudioPlaybackStream.GetVolume(): integer; +begin + result := _volume; +end; + +procedure TPortaudioPlaybackStream.SetVolume(volume: integer); +begin + // clamp volume + if (volume > 100) then + _volume := 100 + else if (volume < 0) then + _volume := 0 + else + _volume := volume; end; @@ -298,18 +394,26 @@ function AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; userData: Pointer): Integer; cdecl; var - playback : TAudioPlayback_Portaudio; - playbackStream : TPortaudioPlaybackStream; - decodeStream : TAudioDecodeStream; + playback: TAudioPlayback_Portaudio; begin playback := TAudioPlayback_Portaudio(userData); with playback do begin - mixerStream.ReadData(output, frameCount * FrameSize); + MixerStream.ReadData(output, frameCount * FrameSize); end; result := paContinue; end; +procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; +var + playback: TAudioPlayback_Portaudio; +begin + playback := TAudioPlayback_Portaudio(userdata); + with playback do + begin + //MixerStream.ReadData(stream, len); + end; +end; function TAudioPlayback_Portaudio.GetName: String; begin @@ -349,10 +453,11 @@ begin device := paOutDevice; channelCount := 2; sampleFormat := paInt16; - suggestedLatency := paOutDeviceInfo^.defaultLowOutputLatency; + suggestedLatency := paOutDeviceInfo^.defaultHighOutputLatency; hostApiSpecificStreamInfo := nil; end; + // set the size of one audio frame (2channel 16bit uint sample) FrameSize := 2 * sizeof(Smallint); err := Pa_OpenStream(paStream, nil, @paOutParams, 44100, @@ -384,219 +489,208 @@ begin result := true; end; -procedure TAudioPlayback_Portaudio.InitializePlayback; +function TAudioPlayback_Portaudio.InitializeSDLAudio(): boolean; +var + desiredAudioSpec, obtainedAudioSpec: TSDL_AudioSpec; + err: integer; begin - Log.LogStatus('InitializePlayback', 'UAudioPlayback_Portaudio'); + result := false; - InitializePortaudio(); - mixerStream := TAudioMixerStream.Create; + SDL_InitSubSystem(SDL_INIT_AUDIO); - StartSoundStream := Load(SoundPath + 'Common start.mp3'); - BackSoundStream := Load(SoundPath + 'Common back.mp3'); - SwooshSoundStream := Load(SoundPath + 'menu swoosh.mp3'); - ChangeSoundStream := Load(SoundPath + 'select music change music 50.mp3'); - OptionSoundStream := Load(SoundPath + 'option change col.mp3'); - ClickSoundStream := Load(SoundPath + 'rimshot022b.mp3'); + FillChar(desiredAudioSpec, sizeof(desiredAudioSpec), 0); + with desiredAudioSpec do + begin + freq := 44100; + format := AUDIO_S16SYS; + channels := 2; + samples := 1024; // latency: 23 ms + callback := @SDLAudioCallback; + userdata := Self; + end; -// DrumSoundStream := Load(SoundPath + 'bassdrumhard076b.mp3'); -// HihatSoundStream := Load(SoundPath + 'hihatclosed068b.mp3'); -// ClapSoundStream := Load(SoundPath + 'claps050b.mp3'); + // set the size of one audio frame (2channel 16bit uint sample) + FrameSize := 2 * sizeof(Smallint); + + if(SDL_OpenAudio(@desiredAudioSpec, @obtainedAudioSpec) = -1) then + begin + Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'UAudioPlayback_SDL'); + exit; + end; -// ShuffleSoundStream := Load(SoundPath + 'Shuffle.mp3'); + Log.LogStatus('Opened audio device', 'UAudioPlayback_SDL'); - StartPortaudioStream(); + result := true; end; +function TAudioPlayback_Portaudio.StartSDLAudioStream(): boolean; +begin + SDL_PauseAudio(0); + result := true; +end; -procedure TAudioPlayback_Portaudio.SetVolume(Volume: integer); +procedure TAudioPlayback_Portaudio.StopSDLAudioStream(); begin - //New: Sets Volume only for this Application -(* - BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); - BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); -*) + SDL_CloseAudio(); end; -procedure TAudioPlayback_Portaudio.SetMusicVolume(Volume: Integer); +function TAudioPlayback_Portaudio.InitializePlayback: boolean; begin - //Max Volume Prevention - if Volume > 100 then - Volume := 100; + result := false; - if Volume < 0 then - Volume := 0; + //Log.LogStatus('InitializePlayback', 'UAudioPlayback_Portaudio'); - //Set Volume -// BASS_ChannelSetAttributes (Bass, -1, Volume, -101); + //if(not InitializePortaudio()) then + if(not InitializeSDLAudio()) then + Exit; + + MixerStream := TAudioMixerStream.Create; + + //if(not StartPortaudioStream()) then; + if(not StartSDLAudioStream()) then + Exit; + + result := true; end; -procedure TAudioPlayback_Portaudio.SetLoop(Enabled: boolean); +destructor TAudioPlayback_Portaudio.Destroy; begin - if (MusicStream <> nil) then - if (MusicStream.IsLoaded) then - MusicStream.SetLoop(Enabled); + StopSDLAudioStream(); + + MixerStream.Free(); + MusicStream.Free(); + + inherited Destroy(); end; -function TAudioPlayback_Portaudio.Open(Filename: string): boolean; +function TAudioPlayback_Portaudio.Load(const Filename: String): TPortaudioPlaybackStream; var decodeStream: TAudioDecodeStream; + playbackStream: TPortaudioPlaybackStream; begin - decodeStream := AudioDecoder.Open(Filename); - MusicStream := TPortaudioPlaybackStream.Create(decodeStream); - // FIXME: remove this line - mixerStream.AddStream(MusicStream); + Result := nil; - if(MusicStream.IsLoaded()) then + decodeStream := AudioDecoder.Open(Filename); + if not assigned(decodeStream) then begin - //Set Max Volume - SetMusicVolume(100); + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudioPlayback_Portaudio'); + Exit; end; - Result := MusicStream.IsLoaded(); -end; - -procedure TAudioPlayback_Portaudio.Rewind; -begin - SetPosition(0); -end; + playbackStream := TPortaudioPlaybackStream.Create(); + if (not playbackStream.SetDecodeStream(decodeStream)) then + Exit; -procedure TAudioPlayback_Portaudio.SetPosition(Time: real); -begin - if (MusicStream.IsLoaded) then - begin - MusicStream.SetPosition(Time); - end; -end; + // FIXME: remove this line + MixerStream.AddStream(playbackStream); -function TAudioPlayback_Portaudio.GetPosition: real; -begin - if (MusicStream.IsLoaded) then - Result := MusicStream.GetPosition(); + result := playbackStream; end; -function TAudioPlayback_Portaudio.Length: real; +procedure TAudioPlayback_Portaudio.SetVolume(Volume: integer); begin - Result := 0; - if assigned( MusicStream ) then - if (MusicStream.IsLoaded) then - begin - Result := MusicStream.GetLength(); - end; + // sets volume only for this application + MixerStream.Volume := Volume; end; -procedure TAudioPlayback_Portaudio.Play; +procedure TAudioPlayback_Portaudio.SetMusicVolume(Volume: Integer); begin - if (MusicStream <> nil) then - if (MusicStream.IsLoaded) then - begin - if (MusicStream.GetLoop()) then - begin - end; - // start from beginning... - // actually bass itself does not loop, nor does this TAudio_FFMpeg Class - MusicStream.Play(); - end; + if assigned(MusicStream) then + MusicStream.Volume := Volume; end; -procedure TAudioPlayback_Portaudio.Pause; +procedure TAudioPlayback_Portaudio.SetLoop(Enabled: boolean); begin - if (MusicStream <> nil) then - MusicStream.Pause(); + if assigned(MusicStream) then + MusicStream.SetLoop(Enabled); end; -procedure TAudioPlayback_Portaudio.Stop; +function TAudioPlayback_Portaudio.Open(Filename: string): boolean; +var + decodeStream: TAudioDecodeStream; begin - if MusicStream <> nil then - MusicStream.Stop(); -end; + Result := false; -procedure TAudioPlayback_Portaudio.Close; -begin - if MusicStream <> nil then - MusicStream.Close(); -end; + // free old MusicStream + MusicStream.Free(); -function TAudioPlayback_Portaudio.Finished: boolean; -begin - if MusicStream <> nil then - Result := (MusicStream.GetStatus() = sStopped); -end; + MusicStream := Load(Filename); + if not assigned(MusicStream) then + Exit; -procedure TAudioPlayback_Portaudio.PlayStart; -begin - if StartSoundStream <> nil then - StartSoundStream.Play(); -end; + //Set Max Volume + SetMusicVolume(100); -procedure TAudioPlayback_Portaudio.PlayBack; -begin - if BackSoundStream <> nil then - BackSoundStream.Play(); + Result := true; end; -procedure TAudioPlayback_Portaudio.PlaySwoosh; +procedure TAudioPlayback_Portaudio.Rewind; begin - if SwooshSoundStream <> nil then - SwooshSoundStream.Play(); + SetPosition(0); end; -procedure TAudioPlayback_Portaudio.PlayChange; +procedure TAudioPlayback_Portaudio.SetPosition(Time: real); begin - if ChangeSoundStream <> nil then - ChangeSoundStream.Play(); + if assigned(MusicStream) then + MusicStream.SetPosition(Time); end; -procedure TAudioPlayback_Portaudio.PlayOption; +function TAudioPlayback_Portaudio.GetPosition: real; begin - if OptionSoundStream <> nil then - OptionSoundStream.Play(); + if assigned(MusicStream) then + Result := MusicStream.GetPosition() + else + Result := -1; end; -procedure TAudioPlayback_Portaudio.PlayClick; +function TAudioPlayback_Portaudio.Length: real; begin - if ClickSoundStream <> nil then - ClickSoundStream.Play(); + if assigned(MusicStream) then + Result := MusicStream.GetLength() + else + Result := -1; end; -procedure TAudioPlayback_Portaudio.PlayDrum; +procedure TAudioPlayback_Portaudio.Play; begin - if DrumSoundStream <> nil then - DrumSoundStream.Play(); + if assigned(MusicStream) then + MusicStream.Play(); end; -procedure TAudioPlayback_Portaudio.PlayHihat; +procedure TAudioPlayback_Portaudio.Pause; begin - if HihatSoundStream <> nil then - HihatSoundStream.Play(); + if assigned(MusicStream) then + MusicStream.Pause(); end; -procedure TAudioPlayback_Portaudio.PlayClap; +procedure TAudioPlayback_Portaudio.Stop; begin - if ClapSoundStream <> nil then - ClapSoundStream.Play(); + if assigned(MusicStream) then + MusicStream.Stop(); end; -procedure TAudioPlayback_Portaudio.PlayShuffle; +procedure TAudioPlayback_Portaudio.Close; begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Play(); + if assigned(MusicStream) then + begin + MixerStream.RemoveStream(MusicStream); + MusicStream.Close(); + end; end; -procedure TAudioPlayback_Portaudio.StopShuffle; +function TAudioPlayback_Portaudio.Finished: boolean; begin - if ShuffleSoundStream <> nil then - ShuffleSoundStream.Stop(); + if assigned(MusicStream) then + Result := (MusicStream.GetStatus() = ssStopped) + else + Result := true; end; //Equalizer -function TAudioPlayback_Portaudio.GetFFTData: TFFTData; -var - data: TFFTData; +procedure TAudioPlayback_Portaudio.GetFFTData(var data: TFFTData); begin //Get Channel Data Mono and 256 Values // BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); - result := data; end; // Interface for Visualizer @@ -605,66 +699,24 @@ begin result := 0; end; -function TAudioPlayback_Portaudio.Load(Filename: string): TPortaudioPlaybackStream; -var - decodeStream : TAudioDecodeStream; - playbackStream : TPortaudioPlaybackStream; - csIndex : integer; +function TAudioPlayback_Portaudio.OpenSound(const Filename: String): TAudioPlaybackStream; begin - result := nil; - - decodeStream := AudioDecoder.Open(Filename); - if (decodeStream = nil) then - begin - Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudioPlayback_Portaudio'); - exit; - end; - - playbackStream := TPortaudioPlaybackStream.Create(decodeStream); - // FIXME: remove this line - mixerStream.AddStream(playbackStream); - - //Add CustomSound - csIndex := High(CustomSounds) + 1; - SetLength(CustomSounds, csIndex + 1); - CustomSounds[csIndex].Filename := Filename; - CustomSounds[csIndex].Stream := playbackStream; - - result := playbackStream; + result := Load(Filename); end; -function TAudioPlayback_Portaudio.LoadCustomSound(const Filename: String): Cardinal; -var - S: TAudioPlaybackStream; - I: Integer; - F: String; +procedure TAudioPlayback_Portaudio.PlaySound(stream: TAudioPlaybackStream); begin - //Search for Sound in already loaded Sounds - F := UpperCase(SoundPath + FileName); - For I := 0 to High(CustomSounds) do - begin - if (UpperCase(CustomSounds[I].Filename) = F) then - begin - Result := I; - Exit; - end; - end; - - S := Load(SoundPath + Filename); - if (S <> nil) then - Result := High(CustomSounds) - else - Result := 0; + if assigned(stream) then + stream.Play(); end; -procedure TAudioPlayback_Portaudio.PlayCustomSound(const Index: Cardinal ); +procedure TAudioPlayback_Portaudio.StopSound(stream: TAudioPlaybackStream); begin - if (Index <= High(CustomSounds)) then - CustomSounds[Index].Stream.Play(); + if assigned(stream) then + stream.Stop(); end; - initialization singleton_AudioPlaybackPortaudio := TAudioPlayback_Portaudio.create(); AudioManager.add( singleton_AudioPlaybackPortaudio ); diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 662050dc..a81aa93b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -161,21 +161,25 @@ end; procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); var - Pet : integer; + SampleIndex: integer; + Sound: TSound; + MaxX, MaxY: real; begin; -// Log.LogStatus('Oscilloscope', 'SingDraw'); + 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); } - glBegin(GL_LINE_STRIP); - - glVertex2f(X, -AudioInputProcessor.Sound[NrSound].BufferArray[1] / $10000 * H + Y + H/2); + MaxX := W-1; + MaxY := (H-1) / 2; - for Pet := 2 to AudioInputProcessor.Sound[NrSound].n div 1 do + glBegin(GL_LINE_STRIP); + for SampleIndex := 0 to High(Sound.BufferArray) do begin - glVertex2f( X + (Pet-1) * W / (AudioInputProcessor.Sound[NrSound].n - 1), - -AudioInputProcessor.Sound[NrSound].BufferArray[Pet] / $10000 * H + Y + H/2 ); + glVertex2f(X + MaxX * SampleIndex/High(Sound.BufferArray), + Y + MaxY * (1 - Sound.BufferArray[SampleIndex]/-Low(Smallint))); end; glEnd; end; diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 599bb8fa..4ac67cda 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -1,798 +1,801 @@ -unit UIni; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses IniFiles, ULog, SysUtils; - -type - TIni = class - Name: array[0..11] of string; - - // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; - - //Filename of the opened iniFile - Filename: string; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - Threshold: integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - - // Record - Card: integer; // not saved in config.ini - - CardList: array of record - Name: string; - Input: integer; - ChannelL: integer; - ChannelR: integer; - end; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskbeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - - // Soundcards - SoundCard: array[0..7, 1..2] of integer; - - // Devices - LPT: integer; - - procedure Load; - procedure Save; - procedure SaveNames; - procedure SaveLevel; - end; - - -var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - ICard: array of string; - IInput: array of string; - -const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); - - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; - - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ISingWindow: array[0..1] of string = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); - //IOscilloscope: array[0..1] of string = ('Off', 'On'); - - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - - - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array [0..1] of String =('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); - - IJoypad: array[0..1] of string = ('Off', 'On'); - ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); - - IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); - -implementation - -uses //UFiles, - UMain, - SDL, - ULanguage, - UPlatform, - USkins, - URecord, - UCommandLine; - -procedure TIni.Load; -var - IniFile: TMemIniFile; - ThemeIni: TMemIniFile; - Tekst: string; - Pet: integer; - B: boolean; - I, I2, I3: integer; - S: string; - Modes: PPSDL_Rect; - SR: TSearchRec; //Skin List Patch - - function GetFileName (S: String):String; - begin - //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); - Result := copy (S,0,Pos ('.ini',S)-1); - end; - -begin - GamePath := Platform.GetGameUserPath; - - if (Params.ConfigFile <> '') then - try - IniFile := TMemIniFile.Create(Params.ConfigFile); - except - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - end - else - IniFile := TMemIniFile.Create(GamePath + 'config.ini'); - - - // Name - for I := 0 to 11 do - Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - - // Templates for Names Mod - for I := 0 to 2 do - Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); - for Pet := 0 to High(IPlayers) do - if Tekst = IPlayers[Pet] then Ini.Players := Pet; - - // Difficulty - Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); - for Pet := 0 to High(IDifficulty) do - if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; - - // Language - Tekst := IniFile.ReadString('Game', 'Language', 'English'); - for Pet := 0 to High(ILanguage) do - if Tekst = ILanguage[Pet] then Ini.Language := Pet; - -// Language.ChangeLanguage(ILanguage[Ini.Language]); - - // Tabs - Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); - for Pet := 0 to High(ITabs) do - if Tekst = ITabs[Pet] then Ini.Tabs := Pet; - - //Tabs at Startup fix - Ini.Tabs_at_startup := Ini.Tabs; - - // Sorting - Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); - for Pet := 0 to High(ISorting) do - if Tekst = ISorting[Pet] then Ini.Sorting := Pet; - - // Debug - Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); - for Pet := 0 to High(IDebug) do - if Tekst = IDebug[Pet] then Ini.Debug := Pet; - - //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; - - // Screens - Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); - for Pet := 0 to High(IScreens) do - if Tekst = IScreens[Pet] then Ini.Screens := Pet; - - // FullScreen - Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); - for Pet := 0 to High(IFullScreen) do - if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; - - - // Resolution - SetLength(IResolution, 0); - - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available - while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - end; - - // if no modes were set, then failback to 800x600 - // as per http://sourceforge.net/forum/message.php?msg_id=4544965 - // THANKS : linnex at users.sourceforge.net - if Length(IResolution) < 1 then - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); - Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); - - // Default to fullscreen OFF, in this case ! - Ini.FullScreen := 0; - end; - - // reverse order - for I := 0 to (Length(IResolution) div 2) - 1 do begin - S := IResolution[I]; - IResolution[I] := IResolution[High(IResolution)-I]; - IResolution[High(IResolution)-I] := S; - end; - - Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - for Pet := 0 to High(IResolution) do - if Tekst = IResolution[Pet] then Ini.Resolution := Pet; - - - // Resolution - Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); - for Pet := 0 to High(IDepth) do - if Tekst = IDepth[Pet] then Ini.Depth := Pet; - - // Texture Size - Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); - for Pet := 0 to High(ITextureSize) do - if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; - - // SingWindow - Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); - for Pet := 0 to High(ISingWindow) do - if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; - - // Oscilloscope - Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); - for Pet := 0 to High(IOscilloscope) do - if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; - - // Spectrum - Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); - for Pet := 0 to High(ISpectrum) do - if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; - - // Spectrograph - Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); - for Pet := 0 to High(ISpectrograph) do - if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; - - // MovieSize - Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); - for Pet := 0 to High(IMovieSize) do - if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; - - // MicBoost - Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); - for Pet := 0 to High(IMicBoost) do - if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; - - // ClickAssist - Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); - for Pet := 0 to High(IClickAssist) do - if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; - - // BeatClick - Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); - for Pet := 0 to High(IBeatClick) do - if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; - - // SavePlayback - Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); - for Pet := 0 to High(ISavePlayback) do - if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; - - // Threshold - Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); - for Pet := 0 to High(IThreshold) do - if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; - - //Song Preview - Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); - for Pet := 0 to High(IPreviewVolume) do - if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; - - Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); - for Pet := 0 to High(IPreviewFading) do - if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; - - // Lyrics Font - Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); - for Pet := 0 to High(ILyricsFont) do - if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; - - // Lyrics Effect - Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); - for Pet := 0 to High(ILyricsEffect) do - if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; - - // Solmization - Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); - for Pet := 0 to High(ISolmization) do - if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; - - // Theme - - //Theme List Patch - - //I2 Saves the no of the Deluxe (Standard-) Theme - I2 := 0; - //I counts is the cur. Theme no - I := 0; - - SetLength(ITheme, 0); - writeln( 'Searching for Theme : '+ ThemePath + '*.ini' ); - FindFirst(ThemePath + '*.ini',faAnyFile,SR); - Repeat - writeln( SR.Name ); - - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SR.Name); - Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); - ThemeIni.Free; - - //if Deluxe Theme then save Themeno to I2 - if (Tekst = 'DELUXE') then - I2 := I; - - //Search for Skins for this Theme - for Pet := low(Skin.Skin) to high(Skin.Skin) do - begin - if UpperCase(Skin.Skin[Pet].Theme) = Tekst then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := GetFileName(SR.Name); - break; - end; - end; - - Inc(I); - Until FindNext(SR) <> 0; - FindClose(SR); - //Theme List Patch End } - - //No Theme Found - if (Length(ITheme)=0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - - Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); - Ini.Theme := 0; - for Pet := 0 to High(ITheme) do - if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; - - // Skin - Skin.onThemeChange; - Ini.SkinNo := 0; - - Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); - for Pet := 0 to High(ISkin) do - if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; - - // Color - Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); - for Pet := 0 to High(IColor) do - if Tekst = IColor[Pet] then Ini.Color := Pet; - - // Record - load ini list - SetLength(CardList, 0); - I := 1; - while (IniFile.ValueExists('Record', 'DeviceName' + IntToStr(I)) = true) do begin - //Automatically Delete not Existing Sound Cards - S := IniFile.ReadString('Record', 'DeviceName' + IntToStr(I), ''); - //{ - B := False; - //Look for Soundcard - for I2 := 0 to High(AudioInputProcessor.SoundCard) do - begin - if (S = Trim(AudioInputProcessor.SoundCard[I2].Description)) then - begin - B := True; - Break; - end; - end; - - if B then - begin //} - I3 := Length(CardList); - SetLength(CardList, I3+1); - Ini.CardList[I3].Name := S; - Ini.CardList[I3].Input := IniFile.ReadInteger('Record', 'Input' + IntToStr(I), 0); - Ini.CardList[I3].ChannelL := IniFile.ReadInteger('Record', 'ChannelL' + IntToStr(I), 0); - Ini.CardList[I3].ChannelR := IniFile.ReadInteger('Record', 'ChannelR' + IntToStr(I), 0); - end; - Inc(I); - end; - - // Record - append detected soundcards - for I := 0 to High(AudioInputProcessor.SoundCard) do - begin - B := False; - For I2 := 0 to High(CardList) do - begin //Search for Card in List - if (CardList[I2].Name = Trim(AudioInputProcessor.SoundCard[I].Description)) then - begin - B := True; - Break; - end; - end; - - //If not in List -> Add - If not B then - begin - I3 := Length(CardList); - SetLength(CardList, I3+1); - CardList[I3].Name := Trim(AudioInputProcessor.SoundCard[I].Description); - CardList[I3].Input := 0; - CardList[I3].ChannelL := 0; - CardList[I3].ChannelR := 0; - // default for new users - if (Length(CardList) = 1) then - CardList[I].ChannelL := 1; - end; - end; - - //Advanced Settings - - // LoadAnimation - Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); - for Pet := 0 to High(ILoadAnimation) do - if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; - - // ScreenFade - Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); - for Pet := 0 to High(IScreenFade) do - if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; - - // EffectSing - Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); - for Pet := 0 to High(IEffectSing) do - if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; - - // AskbeforeDel - Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); - for Pet := 0 to High(IAskbeforeDel) do - if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; - - // OnSongClick - Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); - for Pet := 0 to High(IOnSongClick) do - if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; - - // Linebonus - Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); - for Pet := 0 to High(ILineBonus) do - if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; - - // PartyPopup - Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); - for Pet := 0 to High(IPartyPopup) do - if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; - - - // Joypad - Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); - for Pet := 0 to High(IJoypad) do - if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; - - // LCD - Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); - for Pet := 0 to High(ILPT) do - if Tekst = ILPT[Pet] then Ini.LPT := Pet; - - - // SongPath - if (Params.SongPath <> '') then - SongPath := IncludeTrailingPathDelimiter(Params.SongPath) - else - SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); - - Filename := IniFile.FileName; - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; - Tekst: string; - I: Integer; - S: String; -begin - //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin - if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin - - IniFile := TIniFile.Create(Filename); - - // Players - Tekst := IPlayers[Ini.Players]; - IniFile.WriteString('Game', 'Players', Tekst); - - // Difficulty - Tekst := IDifficulty[Ini.Difficulty]; - IniFile.WriteString('Game', 'Difficulty', Tekst); - - // Language - Tekst := ILanguage[Ini.Language]; - IniFile.WriteString('Game', 'Language', Tekst); - - // Tabs - Tekst := ITabs[Ini.Tabs]; - IniFile.WriteString('Game', 'Tabs', Tekst); - - // Sorting - Tekst := ISorting[Ini.Sorting]; - IniFile.WriteString('Game', 'Sorting', Tekst); - - // Debug - Tekst := IDebug[Ini.Debug]; - IniFile.WriteString('Game', 'Debug', Tekst); - - // Screens - Tekst := IScreens[Ini.Screens]; - IniFile.WriteString('Graphics', 'Screens', Tekst); - - // FullScreen - Tekst := IFullScreen[Ini.FullScreen]; - IniFile.WriteString('Graphics', 'FullScreen', Tekst); - - // Resolution - Tekst := IResolution[Ini.Resolution]; - IniFile.WriteString('Graphics', 'Resolution', Tekst); - - // Depth - Tekst := IDepth[Ini.Depth]; - IniFile.WriteString('Graphics', 'Depth', Tekst); - - // Resolution - Tekst := ITextureSize[Ini.TextureSize]; - IniFile.WriteString('Graphics', 'TextureSize', Tekst); - - // Sing Window - Tekst := ISingWindow[Ini.SingWindow]; - IniFile.WriteString('Graphics', 'SingWindow', Tekst); - - // Oscilloscope - Tekst := IOscilloscope[Ini.Oscilloscope]; - IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); - - // Spectrum - Tekst := ISpectrum[Ini.Spectrum]; - IniFile.WriteString('Graphics', 'Spectrum', Tekst); - - // Spectrograph - Tekst := ISpectrograph[Ini.Spectrograph]; - IniFile.WriteString('Graphics', 'Spectrograph', Tekst); - - // Movie Size - Tekst := IMovieSize[Ini.MovieSize]; - IniFile.WriteString('Graphics', 'MovieSize', Tekst); - - // MicBoost - Tekst := IMicBoost[Ini.MicBoost]; - IniFile.WriteString('Sound', 'MicBoost', Tekst); - - // ClickAssist - Tekst := IClickAssist[Ini.ClickAssist]; - IniFile.WriteString('Sound', 'ClickAssist', Tekst); - - // BeatClick - Tekst := IBeatClick[Ini.BeatClick]; - IniFile.WriteString('Sound', 'BeatClick', Tekst); - - // Threshold - Tekst := IThreshold[Ini.Threshold]; - IniFile.WriteString('Sound', 'Threshold', Tekst); - - // Song Preview - Tekst := IPreviewVolume[Ini.PreviewVolume]; - IniFile.WriteString('Sound', 'PreviewVolume', Tekst); - - Tekst := IPreviewFading[Ini.PreviewFading]; - IniFile.WriteString('Sound', 'PreviewFading', Tekst); - - // SavePlayback - Tekst := ISavePlayback[Ini.SavePlayback]; - IniFile.WriteString('Sound', 'SavePlayback', Tekst); - - // Lyrics Font - Tekst := ILyricsFont[Ini.LyricsFont]; - IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); - - // Lyrics Effect - Tekst := ILyricsEffect[Ini.LyricsEffect]; - IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); - - // Solmization - Tekst := ISolmization[Ini.Solmization]; - IniFile.WriteString('Lyrics', 'Solmization', Tekst); - - // Theme - Tekst := ITheme[Ini.Theme]; - IniFile.WriteString('Themes', 'Theme', Tekst); - - // Skin - Tekst := ISkin[Ini.SkinNo]; - IniFile.WriteString('Themes', 'Skin', Tekst); - - // Color - Tekst := IColor[Ini.Color]; - IniFile.WriteString('Themes', 'Color', Tekst); - - // Record - for I := 0 to High(CardList) do begin - S := IntToStr(I+1); - - Tekst := CardList[I].Name; - IniFile.WriteString('Record', 'DeviceName' + S, Tekst); - - Tekst := IntToStr(CardList[I].Input); - IniFile.WriteString('Record', 'Input' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelL); - IniFile.WriteString('Record', 'ChannelL' + S, Tekst); - - Tekst := IntToStr(CardList[I].ChannelR); - IniFile.WriteString('Record', 'ChannelR' + S, Tekst); - end; - - //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); - - //Advanced Settings - - //LoadAnimation - Tekst := ILoadAnimation[Ini.LoadAnimation]; - IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); - - //EffectSing - Tekst := IEffectSing[Ini.EffectSing]; - IniFile.WriteString('Advanced', 'EffectSing', Tekst); - - //ScreenFade - Tekst := IScreenFade[Ini.ScreenFade]; - IniFile.WriteString('Advanced', 'ScreenFade', Tekst); - - //AskbeforeDel - Tekst := IAskbeforeDel[Ini.AskbeforeDel]; - IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); - - //OnSongClick - Tekst := IOnSongClick[Ini.OnSongClick]; - IniFile.WriteString('Advanced', 'OnSongClick', Tekst); - - //Line Bonus - Tekst := ILineBonus[Ini.LineBonus]; - IniFile.WriteString('Advanced', 'LineBonus', Tekst); - - //Party Popup - Tekst := IPartyPopup[Ini.PartyPopup]; - IniFile.WriteString('Advanced', 'PartyPopup', Tekst); - - // Joypad - Tekst := IJoypad[Ini.Joypad]; - IniFile.WriteString('Controller', 'Joypad', Tekst); - - IniFile.Free; - end; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - //Name - // Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); - - IniFile.Free; - end; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; - I: integer; -begin - //if not FileIsReadOnly(GamePath + 'config.ini') then begin - //IniFile := TIniFile.Create(GamePath + 'config.ini'); - if not FileIsReadOnly(Filename) then begin - IniFile := TIniFile.Create(Filename); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); - - IniFile.Free; - end; -end; - -end. +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses IniFiles, ULog, SysUtils; + +type + PInputDeviceConfig = ^TInputDeviceConfig; + TInputDeviceConfig = record + Name: string; + Input: integer; + ChannelToPlayerMap: array[0..1] of integer; + end; + +type + TIni = class + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + Threshold: integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + + // Record + InputDeviceConfig: array of TInputDeviceConfig; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskbeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + // Soundcards + SoundCard: array[0..7, 1..2] of integer; + + // Devices + LPT: integer; + + procedure Load; + procedure Save; + procedure SaveNames; + procedure SaveLevel; + end; + + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + ICard: array of string; + IInput: array of string; + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); + //IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array [0..1] of String =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights'); + + IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + +implementation + +uses //UFiles, + UMain, + SDL, + ULanguage, + UPlatform, + USkins, + URecord, + UCommandLine; + +procedure TIni.Load; +var + IniFile: TMemIniFile; + ThemeIni: TMemIniFile; + Tekst: string; + Pet: integer; + B: boolean; + I, I2, I3: integer; + S: string; + Modes: PPSDL_Rect; + SR: TSearchRec; //Skin List Patch + + function GetFileName (S: String):String; + begin + //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1); + Result := copy (S,0,Pos ('.ini',S)-1); + end; + +begin + GamePath := Platform.GetGameUserPath; + + if (Params.ConfigFile <> '') then + try + IniFile := TMemIniFile.Create(Params.ConfigFile); + except + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + end + else + IniFile := TMemIniFile.Create(GamePath + 'config.ini'); + + + // Name + for I := 0 to 11 do + Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + + // Templates for Names Mod + for I := 0 to 2 do + Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]); + for Pet := 0 to High(IPlayers) do + if Tekst = IPlayers[Pet] then Ini.Players := Pet; + + // Difficulty + Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy'); + for Pet := 0 to High(IDifficulty) do + if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet; + + // Language + Tekst := IniFile.ReadString('Game', 'Language', 'English'); + for Pet := 0 to High(ILanguage) do + if Tekst = ILanguage[Pet] then Ini.Language := Pet; + +// Language.ChangeLanguage(ILanguage[Ini.Language]); + + // Tabs + Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]); + for Pet := 0 to High(ITabs) do + if Tekst = ITabs[Pet] then Ini.Tabs := Pet; + + //Tabs at Startup fix + Ini.Tabs_at_startup := Ini.Tabs; + + // Sorting + Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]); + for Pet := 0 to High(ISorting) do + if Tekst = ISorting[Pet] then Ini.Sorting := Pet; + + // Debug + Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]); + for Pet := 0 to High(IDebug) do + if Tekst = IDebug[Pet] then Ini.Debug := Pet; + + //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\'; + + // Screens + Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]); + for Pet := 0 to High(IScreens) do + if Tekst = IScreens[Pet] then Ini.Screens := Pet; + + // FullScreen + Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On'); + for Pet := 0 to High(IFullScreen) do + if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet; + + + // Resolution + SetLength(IResolution, 0); + + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + end; + + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600); + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + Ini.FullScreen := 0; + end; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do begin + S := IResolution[I]; + IResolution[I] := IResolution[High(IResolution)-I]; + IResolution[High(IResolution)-I] := S; + end; + + Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + for Pet := 0 to High(IResolution) do + if Tekst = IResolution[Pet] then Ini.Resolution := Pet; + + + // Resolution + Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit'); + for Pet := 0 to High(IDepth) do + if Tekst = IDepth[Pet] then Ini.Depth := Pet; + + // Texture Size + Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]); + for Pet := 0 to High(ITextureSize) do + if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet; + + // SingWindow + Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big'); + for Pet := 0 to High(ISingWindow) do + if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet; + + // Oscilloscope + Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'); + for Pet := 0 to High(IOscilloscope) do + if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet; + + // Spectrum + Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off'); + for Pet := 0 to High(ISpectrum) do + if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet; + + // Spectrograph + Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off'); + for Pet := 0 to High(ISpectrograph) do + if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet; + + // MovieSize + Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]); + for Pet := 0 to High(IMovieSize) do + if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet; + + // MicBoost + Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off'); + for Pet := 0 to High(IMicBoost) do + if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet; + + // ClickAssist + Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off'); + for Pet := 0 to High(IClickAssist) do + if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet; + + // BeatClick + Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]); + for Pet := 0 to High(IBeatClick) do + if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet; + + // SavePlayback + Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]); + for Pet := 0 to High(ISavePlayback) do + if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet; + + // Threshold + Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]); + for Pet := 0 to High(IThreshold) do + if Tekst = IThreshold[Pet] then Ini.Threshold := Pet; + + //Song Preview + Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]); + for Pet := 0 to High(IPreviewVolume) do + if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet; + + Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]); + for Pet := 0 to High(IPreviewFading) do + if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet; + + // Lyrics Font + Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]); + for Pet := 0 to High(ILyricsFont) do + if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet; + + // Lyrics Effect + Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]); + for Pet := 0 to High(ILyricsEffect) do + if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet; + + // Solmization + Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]); + for Pet := 0 to High(ISolmization) do + if Tekst = ISolmization[Pet] then Ini.Solmization := Pet; + + // Theme + + //Theme List Patch + + //I2 Saves the no of the Deluxe (Standard-) Theme + I2 := 0; + //I counts is the cur. Theme no + I := 0; + + SetLength(ITheme, 0); + writeln( 'Searching for Theme : '+ ThemePath + '*.ini' ); + FindFirst(ThemePath + '*.ini',faAnyFile,SR); + Repeat + writeln( SR.Name ); + + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SR.Name); + Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name))); + ThemeIni.Free; + + //if Deluxe Theme then save Themeno to I2 + if (Tekst = 'DELUXE') then + I2 := I; + + //Search for Skins for this Theme + for Pet := low(Skin.Skin) to high(Skin.Skin) do + begin + if UpperCase(Skin.Skin[Pet].Theme) = Tekst then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := GetFileName(SR.Name); + break; + end; + end; + + Inc(I); + Until FindNext(SR) <> 0; + FindClose(SR); + //Theme List Patch End } + + //No Theme Found + if (Length(ITheme)=0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + + Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]); + Ini.Theme := 0; + for Pet := 0 to High(ITheme) do + if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet; + + // Skin + Skin.onThemeChange; + Ini.SkinNo := 0; + + Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]); + for Pet := 0 to High(ISkin) do + if Tekst = ISkin[Pet] then Ini.SkinNo := Pet; + + // Color + Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]); + for Pet := 0 to High(IColor) do + if Tekst = IColor[Pet] then Ini.Color := Pet; + + // Input devices - load ini list + SetLength(InputDeviceConfig, 0); + I := 1; + while (IniFile.ValueExists('Record', 'DeviceName'+IntToStr(I))) do begin + // resize list + SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); + I2 := High(InputDeviceConfig); + + // read an input device's config. + // Note: All devices are appended to the list whether they exist or not. + // Otherwise an external device's config will be lost if it is not + // connected (e.g. singstar mics or USB-Audio devices). + InputDeviceConfig[I2].Name := + IniFile.ReadString('Record', 'DeviceName'+IntToStr(I), ''); + InputDeviceConfig[I2].Input := + IniFile.ReadInteger('Record', 'Input'+IntToStr(I), 0); + InputDeviceConfig[I2].ChannelToPlayerMap[0] := + IniFile.ReadInteger('Record', 'ChannelL'+IntToStr(I), 0); + InputDeviceConfig[I2].ChannelToPlayerMap[1] := + IniFile.ReadInteger('Record', 'ChannelR'+IntToStr(I), 0); + + Inc(I); + end; + + // Input devices - append detected soundcards + for I := 0 to High(AudioInputProcessor.Device) do + begin + B := False; + For I2 := 0 to High(InputDeviceConfig) do + begin //Search for Card in List + if (InputDeviceConfig[I2].Name = Trim(AudioInputProcessor.Device[I].Description)) then + begin + B := True; + // associate ini-index with device + AudioInputProcessor.Device[I].CfgIndex := I2; + Break; + end; + end; + + //If not in List -> Add + If not B then + begin + // resize list + SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); + I2 := High(InputDeviceConfig); + + InputDeviceConfig[I2].Name := Trim(AudioInputProcessor.Device[I].Description); + InputDeviceConfig[I2].Input := 0; + InputDeviceConfig[I2].ChannelToPlayerMap[0] := 0; + InputDeviceConfig[I2].ChannelToPlayerMap[1] := 0; + + // associate ini-index with device + AudioInputProcessor.Device[I].CfgIndex := I2; + + // set default at first start of USDX (1st device, 1st channel -> player1) + if (I2 = 0) then + InputDeviceConfig[I2].ChannelToPlayerMap[0] := 1; + end; + end; + + //Advanced Settings + + // LoadAnimation + Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On'); + for Pet := 0 to High(ILoadAnimation) do + if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet; + + // ScreenFade + Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On'); + for Pet := 0 to High(IScreenFade) do + if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet; + + // EffectSing + Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On'); + for Pet := 0 to High(IEffectSing) do + if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet; + + // AskbeforeDel + Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'); + for Pet := 0 to High(IAskbeforeDel) do + if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet; + + // OnSongClick + Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'); + for Pet := 0 to High(IOnSongClick) do + if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet; + + // Linebonus + Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score'); + for Pet := 0 to High(ILineBonus) do + if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet; + + // PartyPopup + Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On'); + for Pet := 0 to High(IPartyPopup) do + if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet; + + + // Joypad + Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]); + for Pet := 0 to High(IJoypad) do + if Tekst = IJoypad[Pet] then Ini.Joypad := Pet; + + // LCD + Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]); + for Pet := 0 to High(ILPT) do + if Tekst = ILPT[Pet] then Ini.LPT := Pet; + + + // SongPath + if (Params.SongPath <> '') then + SongPath := IncludeTrailingPathDelimiter(Params.SongPath) + else + SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath)); + + Filename := IniFile.FileName; + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; + Tekst: string; + I: Integer; + S: String; +begin + //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin + if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin + + IniFile := TIniFile.Create(Filename); + + // Players + Tekst := IPlayers[Ini.Players]; + IniFile.WriteString('Game', 'Players', Tekst); + + // Difficulty + Tekst := IDifficulty[Ini.Difficulty]; + IniFile.WriteString('Game', 'Difficulty', Tekst); + + // Language + Tekst := ILanguage[Ini.Language]; + IniFile.WriteString('Game', 'Language', Tekst); + + // Tabs + Tekst := ITabs[Ini.Tabs]; + IniFile.WriteString('Game', 'Tabs', Tekst); + + // Sorting + Tekst := ISorting[Ini.Sorting]; + IniFile.WriteString('Game', 'Sorting', Tekst); + + // Debug + Tekst := IDebug[Ini.Debug]; + IniFile.WriteString('Game', 'Debug', Tekst); + + // Screens + Tekst := IScreens[Ini.Screens]; + IniFile.WriteString('Graphics', 'Screens', Tekst); + + // FullScreen + Tekst := IFullScreen[Ini.FullScreen]; + IniFile.WriteString('Graphics', 'FullScreen', Tekst); + + // Resolution + Tekst := IResolution[Ini.Resolution]; + IniFile.WriteString('Graphics', 'Resolution', Tekst); + + // Depth + Tekst := IDepth[Ini.Depth]; + IniFile.WriteString('Graphics', 'Depth', Tekst); + + // Resolution + Tekst := ITextureSize[Ini.TextureSize]; + IniFile.WriteString('Graphics', 'TextureSize', Tekst); + + // Sing Window + Tekst := ISingWindow[Ini.SingWindow]; + IniFile.WriteString('Graphics', 'SingWindow', Tekst); + + // Oscilloscope + Tekst := IOscilloscope[Ini.Oscilloscope]; + IniFile.WriteString('Graphics', 'Oscilloscope', Tekst); + + // Spectrum + Tekst := ISpectrum[Ini.Spectrum]; + IniFile.WriteString('Graphics', 'Spectrum', Tekst); + + // Spectrograph + Tekst := ISpectrograph[Ini.Spectrograph]; + IniFile.WriteString('Graphics', 'Spectrograph', Tekst); + + // Movie Size + Tekst := IMovieSize[Ini.MovieSize]; + IniFile.WriteString('Graphics', 'MovieSize', Tekst); + + // MicBoost + Tekst := IMicBoost[Ini.MicBoost]; + IniFile.WriteString('Sound', 'MicBoost', Tekst); + + // ClickAssist + Tekst := IClickAssist[Ini.ClickAssist]; + IniFile.WriteString('Sound', 'ClickAssist', Tekst); + + // BeatClick + Tekst := IBeatClick[Ini.BeatClick]; + IniFile.WriteString('Sound', 'BeatClick', Tekst); + + // Threshold + Tekst := IThreshold[Ini.Threshold]; + IniFile.WriteString('Sound', 'Threshold', Tekst); + + // Song Preview + Tekst := IPreviewVolume[Ini.PreviewVolume]; + IniFile.WriteString('Sound', 'PreviewVolume', Tekst); + + Tekst := IPreviewFading[Ini.PreviewFading]; + IniFile.WriteString('Sound', 'PreviewFading', Tekst); + + // SavePlayback + Tekst := ISavePlayback[Ini.SavePlayback]; + IniFile.WriteString('Sound', 'SavePlayback', Tekst); + + // Lyrics Font + Tekst := ILyricsFont[Ini.LyricsFont]; + IniFile.WriteString('Lyrics', 'LyricsFont', Tekst); + + // Lyrics Effect + Tekst := ILyricsEffect[Ini.LyricsEffect]; + IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst); + + // Solmization + Tekst := ISolmization[Ini.Solmization]; + IniFile.WriteString('Lyrics', 'Solmization', Tekst); + + // Theme + Tekst := ITheme[Ini.Theme]; + IniFile.WriteString('Themes', 'Theme', Tekst); + + // Skin + Tekst := ISkin[Ini.SkinNo]; + IniFile.WriteString('Themes', 'Skin', Tekst); + + // Color + Tekst := IColor[Ini.Color]; + IniFile.WriteString('Themes', 'Color', Tekst); + + // Record + for I := 0 to High(InputDeviceConfig) do begin + S := IntToStr(I+1); + + Tekst := InputDeviceConfig[I].Name; + IniFile.WriteString('Record', 'DeviceName' + S, Tekst); + + Tekst := IntToStr(InputDeviceConfig[I].Input); + IniFile.WriteString('Record', 'Input' + S, Tekst); + + Tekst := IntToStr(InputDeviceConfig[I].ChannelToPlayerMap[0]); + IniFile.WriteString('Record', 'ChannelL' + S, Tekst); + + Tekst := IntToStr(InputDeviceConfig[I].ChannelToPlayerMap[1]); + IniFile.WriteString('Record', 'ChannelR' + S, Tekst); + end; + + //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved'); + + //Advanced Settings + + //LoadAnimation + Tekst := ILoadAnimation[Ini.LoadAnimation]; + IniFile.WriteString('Advanced', 'LoadAnimation', Tekst); + + //EffectSing + Tekst := IEffectSing[Ini.EffectSing]; + IniFile.WriteString('Advanced', 'EffectSing', Tekst); + + //ScreenFade + Tekst := IScreenFade[Ini.ScreenFade]; + IniFile.WriteString('Advanced', 'ScreenFade', Tekst); + + //AskbeforeDel + Tekst := IAskbeforeDel[Ini.AskbeforeDel]; + IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst); + + //OnSongClick + Tekst := IOnSongClick[Ini.OnSongClick]; + IniFile.WriteString('Advanced', 'OnSongClick', Tekst); + + //Line Bonus + Tekst := ILineBonus[Ini.LineBonus]; + IniFile.WriteString('Advanced', 'LineBonus', Tekst); + + //Party Popup + Tekst := IPartyPopup[Ini.PartyPopup]; + IniFile.WriteString('Advanced', 'PartyPopup', Tekst); + + // Joypad + Tekst := IJoypad[Ini.Joypad]; + IniFile.WriteString('Controller', 'Joypad', Tekst); + + IniFile.Free; + end; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + //Name + // Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Ini.Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; + I: integer; +begin + //if not FileIsReadOnly(GamePath + 'config.ini') then begin + //IniFile := TIniFile.Create(GamePath + 'config.ini'); + if not FileIsReadOnly(Filename) then begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]); + + IniFile.Free; + end; +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 901d7370..801a66db 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -195,23 +195,14 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Skin List', 1); -(* - // Sound Card List - Log.BenchmarkStart(1); - Log.LogStatus('Loading Soundcard list', 'Initialization'); - Recording := TRecord.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Soundcard list', 1); -*) - - // Sound (+ fills Sound Card List) + // Sound Log.BenchmarkStart(1); Log.LogStatus('Initialize Sound', 'Initialization'); InitializeSound(); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing Sound', 1); - // Ini + Paths + // Ini + Paths (depends on Sound) Log.BenchmarkStart(1); Log.LogStatus('Load Ini', 'Initialization'); Ini := TIni.Create; @@ -758,7 +749,7 @@ begin // beat click if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - AudioPlayback.PlayClick; + AudioPlayback.PlaySound(SoundLib.Click); // debug system on LPT if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin @@ -780,7 +771,7 @@ begin if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin // click assist if Ini.ClickAssist = 1 then - AudioPlayback.PlayClick; + AudioPlayback.PlaySound(SoundLib.Click); //LPT_2 := 0; if ParamStr(1) <> '-doublelights' then @@ -871,7 +862,7 @@ begin // Czas.Ton := 27; // gdy moze, to dodaje nute - if (AudioInputProcessor.Sound[CP].SzczytJest) and (Mozna) then begin + if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then begin // operowanie na ostatniej nucie for Pet := 0 to Czesci[0].Czesc[S].HighNut do if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) @@ -880,11 +871,11 @@ begin // to robi, tylko dla pary nut (oryginalnej i gracza) // przesuwanie tonu w odpowiednia game - while (AudioInputProcessor.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - AudioInputProcessor.Sound[CP].Ton := AudioInputProcessor.Sound[CP].Ton - 12; + while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12; - while (AudioInputProcessor.Sound[CP].Ton - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - AudioInputProcessor.Sound[CP].Ton := AudioInputProcessor.Sound[CP].Ton + 12; + while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone + 12; // Half size Notes Patch NoteHit := false; @@ -894,8 +885,8 @@ begin //if Ini.Difficulty = 2 then Range := 0; Range := 2 - Ini.Difficulty; - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Ton) <= Range then begin - AudioInputProcessor.Sound[CP].Ton := Czesci[0].Czesc[S].Nuta[Pet].Ton; + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Tone) <= Range then begin + AudioInputProcessor.Sound[CP].Tone := Czesci[0].Czesc[S].Nuta[Pet].Ton; // Half size Notes Patch @@ -936,7 +927,7 @@ begin Nowa := true; // jezeli ostatnia ma ten sam ton if (Player[CP].IlNut > 0 ) - and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Ton) + and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Tone) and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) then Nowa := false; // jezeli jest jakas nowa nuta na sprawdzanym beacie @@ -952,7 +943,7 @@ begin SetLength(Player[CP].Nuta, Player[CP].IlNut); Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Ton; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index c973512d..cd62dc51 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -1,268 +1,206 @@ -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 - public - constructor create(); - function GetName: String; - - procedure init(); - - function Open( 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 - procedure InitializeRecord; - procedure CaptureStart; - procedure CaptureStop; - procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); - procedure StopCard(Card: byte); - function GetFFTData: TFFTData; - function GetPCMData(var data: TPCMData): Cardinal; - - // IAudioPlayback - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - procedure Rewind; - - function Finished: boolean; - function Length: real; - - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - - 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 -end; - -procedure Tmedia_dummy.init(); -begin -end; - - -function Tmedia_dummy.Open( 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 -procedure Tmedia_dummy.InitializeRecord; -begin -end; - -procedure Tmedia_dummy.CaptureStart; -begin -end; - -procedure Tmedia_dummy.CaptureStop; -begin -end; - -procedure Tmedia_dummy.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte); -begin -end; - -procedure Tmedia_dummy.StopCard(Card: byte); -begin -end; - -function Tmedia_dummy.GetFFTData: TFFTData; -var data: TFFTData; -begin - result := data; -end; - -function Tmedia_dummy.GetPCMData(var data: TPCMData): Cardinal; -begin - result := 0; -end; - -// IAudioPlayback -procedure Tmedia_dummy.InitializePlayback; -begin -end; - -procedure Tmedia_dummy.SetVolume(Volume: integer); -begin -end; - -procedure Tmedia_dummy.SetMusicVolume(Volume: integer); -begin -end; - -procedure Tmedia_dummy.SetLoop(Enabled: boolean); -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; - -procedure Tmedia_dummy.PlayStart; -begin -end; - -procedure Tmedia_dummy.PlayBack; -begin -end; - -procedure Tmedia_dummy.PlaySwoosh; -begin -end; - -procedure Tmedia_dummy.PlayChange; -begin -end; - -procedure Tmedia_dummy.PlayOption; -begin -end; - -procedure Tmedia_dummy.PlayClick; -begin -end; - -procedure Tmedia_dummy.PlayDrum; -begin -end; - -procedure Tmedia_dummy.PlayHihat; -begin -end; - -procedure Tmedia_dummy.PlayClap; -begin -end; - -procedure Tmedia_dummy.PlayShuffle; -begin -end; - -procedure Tmedia_dummy.StopShuffle; -begin -end; - -function Tmedia_dummy.LoadCustomSound(const Filename: String): Cardinal; -begin - result := 0; -end; - -procedure Tmedia_dummy.PlayCustomSound(const Index: Cardinal ); -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 + public + constructor create(); + function GetName: String; + + procedure init(); + + function Open( 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; + procedure CaptureStart; + procedure CaptureStop; + procedure GetFFTData(var data: TFFTData); + function GetPCMData(var data: TPCMData): Cardinal; + + // IAudioPlayback + function InitializePlayback: boolean; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + 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 +end; + +procedure Tmedia_dummy.init(); +begin +end; + + +function Tmedia_dummy.Open( 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; + +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 + result := true; +end; + +procedure Tmedia_dummy.SetVolume(Volume: integer); +begin +end; + +procedure Tmedia_dummy.SetMusicVolume(Volume: integer); +begin +end; + +procedure Tmedia_dummy.SetLoop(Enabled: boolean); +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/UMusic.pas b/Game/Code/Classes/UMusic.pas index a7f1918f..27ab86e1 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -1,423 +1,492 @@ -unit UMusic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes ; - -type - TMuzyka = record - Path: string; - Start: integer; // start of song in ms - IlNut: integer; - DlugoscNut: integer; - end; - - PLine = ^TLine; - TLine = record - Start: integer; - StartNote: integer; - Lyric: string; - LyricWidth: real; - Koniec: integer; - BaseNote: integer; - HighNut: integer; - IlNut: integer; - TotalNotes: integer; - Nuta: array of record - Color: integer; - Start: integer; - Dlugosc: integer; - Ton: integer; - TonGamy: integer; - Tekst: string; - FreeStyle: boolean; - Wartosc: integer; // zwykla nuta x1, zlota nuta x2 - end; - end; - ALine = array of TLine; - - TCzesci = record - Akt: integer; // aktualna czesc utworu do rysowania - High: integer; - Ilosc: integer; - Resolution: integer; - NotesGAP: integer; - Wartosc: integer; - Czesc: ALine; - end; - - TCzas = record // wszystko, co dotyczy aktualnej klatki - OldBeat: integer; // poprzednio wykryty beat w utworze - AktBeat: integer; // aktualny beat w utworze - MidBeat: real; // dokladny AktBeat - - // now we use this for super synchronization! - // only used when analyzing voice - OldBeatD: integer; // poprzednio wykryty beat w utworze - AktBeatD: integer; // aktualny beat w utworze - MidBeatD: real; // dokladny AktBeatD - FracBeatD: real; // fractional part of MidBeatD - - // we use this for audiable clicks - OldBeatC: integer; // poprzednio wykryty beat w utworze - AktBeatC: integer; // aktualny beat w utworze - MidBeatC: real; // dokladny AktBeatC - FracBeatC: real; // fractional part of MidBeatC - - - OldCzesc: integer; // poprzednio wyswietlana czesc - // akt jest w czesci.akt - - Teraz: real; // aktualny czas w utworze - Razem: real; // caly czas utworu - end; - - TSoundCard = record - Name: string; - Source: array of string; - end; - -type - TFFTData = array[0..256] of Single; - - TPCMStereoSample = array[0..1] of Smallint; - TPCMData = array[0..511] of TPCMStereoSample; - -type - TStreamStatus = (sStopped, sPlaying, sPaused); -const - StreamStatusStr: array[TStreamStatus] of string = ('Stopped', 'Playing', 'Paused'); - -type - TAudioProcessingStream = class - public - procedure Close(); virtual; abstract; - end; - - TAudioPlaybackStream = class(TAudioProcessingStream) - protected - function GetLoop(): boolean; virtual; abstract; - procedure SetLoop(Enabled: boolean); virtual; abstract; - function GetLength(): real; virtual; abstract; - function GetStatus(): TStreamStatus; virtual; abstract; - public - procedure Play(); virtual; abstract; - procedure Pause(); virtual; abstract; - procedure Stop(); virtual; abstract; - - property Loop: boolean READ GetLoop WRITE SetLoop; - property Length: real READ GetLength; - property Status: TStreamStatus READ GetStatus; - end; - - (* - TAudioMixerStream = class(TAudioProcessingStream) - procedure AddStream(stream: TAudioProcessingStream); - procedure RemoveStream(stream: TAudioProcessingStream); - procedure SetMasterVolume(volume: cardinal); - function GetMasterVolume(): cardinal; - procedure SetStreamVolume(stream: TAudioProcessingStream; volume: cardinal); - function GetStreamVolume(stream: TAudioProcessingStream): cardinal; - end; - *) - - TAudioDecodeStream = class(TAudioProcessingStream) - protected - function GetLength(): real; virtual; abstract; - function GetChannelCount(): cardinal; virtual; abstract; - function GetSampleRate(): cardinal; virtual; abstract; - function GetPosition(): real; virtual; abstract; - procedure SetPosition(Time: real); virtual; abstract; - function IsEOF(): boolean; virtual; abstract; - public - function ReadData(Buffer: PChar; BufSize: integer): integer; virtual; abstract; - - property Length: real READ GetLength; - property ChannelCount: cardinal READ GetChannelCount; - property SampleRate: cardinal READ GetSampleRate; - property Position: real READ GetPosition WRITE SetPosition; - property EOF: boolean READ IsEOF; - end; - -type - TCustomSoundEntry = record - Filename : String; - Stream : TAudioPlaybackStream; - end; - -type - IGenericPlayback = Interface - ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] - function GetName: String; - - function Open(Filename: string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure SetPosition(Time: real); - function GetPosition: real; - - property Position : real READ GetPosition WRITE SetPosition; - end; - - IVideoPlayback = Interface( IGenericPlayback ) - ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] - procedure init(); - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC - - end; - - IVideoVisualization = Interface( IVideoPlayback ) - ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] - end; - - IAudioPlayback = Interface( IGenericPlayback ) - ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] - procedure InitializePlayback; - procedure SetVolume(Volume: integer); - procedure SetMusicVolume(Volume: integer); - procedure SetLoop(Enabled: boolean); - - procedure Rewind; - function Finished: boolean; - function Length: real; - - procedure PlayStart; - procedure PlayBack; - procedure PlaySwoosh; - procedure PlayChange; - procedure PlayOption; - procedure PlayClick; - procedure PlayDrum; - procedure PlayHihat; - procedure PlayClap; - procedure PlayShuffle; - procedure StopShuffle; - - //Custom Sounds - function LoadCustomSound(const Filename: String): Cardinal; - procedure PlayCustomSound(const Index: Cardinal ); - - //Equalizer - function GetFFTData: TFFTData; - - // Interface for Visualizer - function GetPCMData(var data: TPCMData): Cardinal; - end; - - IGenericDecoder = Interface - ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] - function InitializeDecoder(): boolean; - //function IsSupported(const Filename: string): boolean; - end; - - (* - IVideoDecoder = Interface( IGenericDecoder ) - ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] - function Open(const Filename: string): TVideoDecodeStream; - end; - *) - - IAudioDecoder = Interface( IGenericDecoder ) - ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] - function Open(const Filename: string): TAudioDecodeStream; - end; - - IAudioInput = Interface - ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] - function GetName: String; - procedure InitializeRecord; - - procedure CaptureStart; - procedure CaptureStop; - end; - - -var // TODO : JB --- THESE SHOULD NOT BE GLOBAL - // muzyka - Muzyka: TMuzyka; - - // czesci z nutami; - Czesci: array of TCzesci; - - // czas - Czas: TCzas; - - -procedure InitializeSound; - -function Visualization(): IVideoPlayback; -function VideoPlayback(): IVideoPlayback; -function AudioPlayback(): IAudioPlayback; -function AudioInput(): IAudioInput; -function AudioDecoder(): IAudioDecoder; - -function AudioManager: TInterfaceList; - - -implementation - -uses - sysutils, - UCommandLine; -// uLog; - -var - singleton_VideoPlayback : IVideoPlayback = nil; - singleton_Visualization : IVideoPlayback = nil; - singleton_AudioPlayback : IAudioPlayback = nil; - singleton_AudioInput : IAudioInput = nil; - singleton_AudioDecoder : IAudioDecoder = nil; - - singleton_AudioManager : TInterfaceList = nil; - - -function AudioManager: TInterfaceList; -begin - if singleton_AudioManager = nil then - singleton_AudioManager := TInterfaceList.Create(); - - Result := singleton_AudioManager; -end; //CompressionPluginManager - - -function VideoPlayback(): IVideoPlayback; -begin - result := singleton_VideoPlayback; -end; - -function Visualization(): IVideoPlayback; -begin - result := singleton_Visualization; -end; - -function AudioPlayback(): IAudioPlayback; -begin - result := singleton_AudioPlayback; -end; - -function AudioInput(): IAudioInput; -begin - result := singleton_AudioInput; -end; - -function AudioDecoder(): IAudioDecoder; -begin - result := singleton_AudioDecoder; -end; - -procedure InitializeSound; -var - lTmpInterface : IInterface; - iCount : Integer; -begin - lTmpInterface := nil; - - singleton_AudioPlayback := nil; - singleton_AudioInput := nil; - singleton_AudioDecoder := nil; - singleton_VideoPlayback := nil; - singleton_Visualization := nil; - - for iCount := 0 to AudioManager.Count - 1 do - begin - if assigned( AudioManager[iCount] ) then - begin - // if this interface is a Playback, then set it as the default used - - if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND - ( true ) then - begin - singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); - end; - - // if this interface is a Input, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND - ( true ) then - begin - singleton_AudioInput := IAudioInput( lTmpInterface ); - end; - - // if this interface is a Decoder, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IAudioDecoder, lTmpInterface ) = 0 ) AND - ( true ) then - begin - singleton_AudioDecoder := IAudioDecoder( lTmpInterface ); - end; - - // if this interface is a Input, then set it as the default used - if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND - ( true ) then - begin - singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); - end; - - if ( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) = 0 ) AND - ( true ) then - begin - singleton_Visualization := IVideoPlayback( lTmpInterface ); - end; - - end; - end; - - - - if VideoPlayback <> nil then - begin - end; - - if AudioDecoder <> nil then - begin - AudioDecoder.InitializeDecoder; - end; - - if AudioPlayback <> nil then - begin - AudioPlayback.InitializePlayback; - end; - - if AudioInput <> nil then - begin - AudioInput.InitializeRecord; - end; - - if FindCmdLineSwitch( cMediaInterfaces ) then - begin - writeln( '' ); - writeln( '--------------------------------------------------------------' ); - writeln( ' In-use Media Interfaces ' ); - writeln( '--------------------------------------------------------------' ); - writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); - writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); - writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); - writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); - writeln( '--------------------------------------------------------------' ); - writeln( '' ); - - halt; - end; -end; - -initialization -begin - singleton_AudioManager := TInterfaceList.Create(); - -end; - -finalization - singleton_AudioManager.clear; - FreeAndNil( singleton_AudioManager ); - -end. +unit UMusic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes; + +type + TNoteType = (ntFreestyle, ntNormal, ntGolden); + + //http://paste.ubuntu-nl.org/51892/ + + TMuzyka = record // (TODO: rename to TMusic/TMelody?) + Path: string; + Start: integer; // start of song in ms + IlNut: integer; // (TODO: Il = tone, Nut(a) = Note) + DlugoscNut: integer; // (TODO: Dlugosc = length, Nut(a) = Note) + end; + + PLine = ^TLine; + TLine = record // (TODO: rename to TSentence?) + Start: integer; + StartNote: integer; + Lyric: string; + LyricWidth: real; + Koniec: integer; // (TODO: rename to End_/Ending?) + BaseNote: integer; + HighNut: integer; // (TODO: rename to HighNote) + IlNut: integer; // (TODO: Il = tone, Nut(a) = Note) + TotalNotes: integer; + Nuta: array of record // (TODO: rename to Note) + Color: integer; + Start: integer; + Dlugosc: integer; // (TODO: rename to Length) + Ton: integer; // full range tone (TODO: rename to Tone) + TonGamy: integer; // tone unified to one octave (TODO: rename to something meaningful, ToneGamus) + Tekst: string; // (TODO: rename to Text) + FreeStyle: boolean; + Wartosc: integer; // normal-note: 1, golden-note: 2 (TODO: wartosc=value, rename to Type_ or Kind?) + end; + end; + ALine = array of TLine; // (TODO: rename to TLineArray) + + // (TCzesci = TSentences) + TCzesci = record + Akt: integer; // for drawing of current line (Akt = Current) + High: integer; + Ilosc: integer; // (TODO: Ilosc = Number/Count) + Resolution: integer; + NotesGAP: integer; + Wartosc: integer; // TODO: rename (wartosc=value) + Czesc: ALine; // TODO: rename to Sentence or Line + end; + + // (TODO: rename TCzas to something like T(Line/Sentence)Time/TLinePosition/TLineState) + // (Czas = time) + TCzas = record // all that concerns the current frames + OldBeat: integer; // previous discovered beat + AktBeat: integer; // current beat (TODO: rename) + MidBeat: real; // like AktBeat + + // now we use this for super synchronization! + // only used when analyzing voice + OldBeatD: integer; // previous discovered beat + AktBeatD: integer; // current beat (TODO: rename) + MidBeatD: real; // like AktBeatD + FracBeatD: real; // fractional part of MidBeatD + + // we use this for audible clicks + OldBeatC: integer; // previous discovered beat + AktBeatC: integer; // current beat (TODO: rename) + MidBeatC: real; // like AktBeatC + FracBeatC: real; // fractional part of MidBeatC + + + OldCzesc: integer; // previous displayed sentence (Czesc = part (here: sentence/line)) + + Teraz: real; // (TODO: Teraz = current time) + Razem: real; // (TODO: Razem = total time) + end; + + +type + TFFTData = array[0..255] of Single; + + TPCMStereoSample = array[0..1] of Smallint; + TPCMData = array[0..511] of TPCMStereoSample; + +type + TStreamStatus = (ssStopped, ssPlaying, ssPaused, ssBlocked, ssUnknown); +const + StreamStatusStr: array[TStreamStatus] of string = + ('Stopped', 'Playing', 'Paused', 'Blocked', 'Unknown'); + +type + TAudioSampleFormat = ( + asfU8, asfS8, // unsigned/signed 8 bits + asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) + asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) + asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) + asfS24, // signed 24 bits (endianness: System) + asfS32, // signed 32 bits (endianness: System) + asfFloat // float + ); + + TAudioFormatInfo = record + Channels: byte; + SampleRate: integer; + Format: TAudioSampleFormat; + end; + +type + TAudioProcessingStream = class + public + procedure Close(); virtual; abstract; + end; + + TAudioPlaybackStream = class(TAudioProcessingStream) + protected + function GetLoop(): boolean; virtual; abstract; + procedure SetLoop(Enabled: boolean); virtual; abstract; + function GetLength(): real; virtual; abstract; + function GetStatus(): TStreamStatus; virtual; abstract; + function GetVolume(): integer; virtual; abstract; + procedure SetVolume(volume: integer); virtual; abstract; + public + procedure Play(); virtual; abstract; + procedure Pause(); virtual; abstract; + procedure Stop(); virtual; abstract; + + property Loop: boolean READ GetLoop WRITE SetLoop; + property Length: real READ GetLength; + property Status: TStreamStatus READ GetStatus; + property Volume: integer READ GetVolume WRITE SetVolume; + end; + + (* + TAudioMixerStream = class(TAudioProcessingStream) + procedure AddStream(stream: TAudioProcessingStream); + procedure RemoveStream(stream: TAudioProcessingStream); + procedure SetMasterVolume(volume: cardinal); + function GetMasterVolume(): cardinal; + procedure SetStreamVolume(stream: TAudioProcessingStream; volume: cardinal); + function GetStreamVolume(stream: TAudioProcessingStream): cardinal; + end; + *) + + TAudioDecodeStream = class(TAudioProcessingStream) + protected + function GetLength(): real; virtual; abstract; + function GetPosition(): real; virtual; abstract; + procedure SetPosition(Time: real); virtual; abstract; + function IsEOF(): boolean; virtual; abstract; + public + function ReadData(Buffer: PChar; BufSize: integer): integer; virtual; abstract; + function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract; + + property Length: real READ GetLength; + property Position: real READ GetPosition WRITE SetPosition; + property EOF: boolean READ IsEOF; + end; + +type + IGenericPlayback = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] + function GetName: String; + + function Open(Filename: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + property Position : real READ GetPosition WRITE SetPosition; + end; + + IVideoPlayback = Interface( IGenericPlayback ) + ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] + procedure init(); + + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + + end; + + IVideoVisualization = Interface( IVideoPlayback ) + ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] + end; + + IAudioPlayback = Interface( IGenericPlayback ) + ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] + function InitializePlayback: boolean; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + + procedure Rewind; + function Finished: boolean; + function Length: real; + + // Sounds + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); + + // Equalizer + procedure GetFFTData(var data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + end; + + IGenericDecoder = Interface + ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] + function InitializeDecoder(): boolean; + //function IsSupported(const Filename: string): boolean; + end; + + (* + IVideoDecoder = Interface( IGenericDecoder ) + ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] + function Open(const Filename: string): TVideoDecodeStream; + end; + *) + + IAudioDecoder = Interface( IGenericDecoder ) + ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] + function Open(const Filename: string): TAudioDecodeStream; + end; + + IAudioInput = Interface + ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] + function GetName: String; + function InitializeRecord: boolean; + + procedure CaptureStart; + procedure CaptureStop; + end; + +type + TSoundLibrary = class + public + Start: TAudioPlaybackStream; + Back: TAudioPlaybackStream; + Swoosh: TAudioPlaybackStream; + Change: TAudioPlaybackStream; + Option: TAudioPlaybackStream; + Click: TAudioPlaybackStream; + Drum: TAudioPlaybackStream; + Hihat: TAudioPlaybackStream; + Clap: TAudioPlaybackStream; + Shuffle: TAudioPlaybackStream; + + constructor Create(); + destructor Destroy(); override; + end; + +var // TODO : JB --- THESE SHOULD NOT BE GLOBAL + // music + Muzyka: TMuzyka; // TODO: rename + + // czesci z nutami; + Czesci: array of TCzesci; // TODO: rename to Sentences/Lines + + // czas + Czas: TCzas; // TODO: rename + + SoundLib: TSoundLibrary; + + +procedure InitializeSound; + +function Visualization(): IVideoPlayback; +function VideoPlayback(): IVideoPlayback; +function AudioPlayback(): IAudioPlayback; +function AudioInput(): IAudioInput; +function AudioDecoder(): IAudioDecoder; + +function AudioManager: TInterfaceList; + + +implementation + +uses + sysutils, + UMain, + UCommandLine; +// uLog; + +var + singleton_VideoPlayback : IVideoPlayback = nil; + singleton_Visualization : IVideoPlayback = nil; + singleton_AudioPlayback : IAudioPlayback = nil; + singleton_AudioInput : IAudioInput = nil; + singleton_AudioDecoder : IAudioDecoder = nil; + + singleton_AudioManager : TInterfaceList = nil; + + +function AudioManager: TInterfaceList; +begin + if singleton_AudioManager = nil then + singleton_AudioManager := TInterfaceList.Create(); + + Result := singleton_AudioManager; +end; //CompressionPluginManager + + +function VideoPlayback(): IVideoPlayback; +begin + result := singleton_VideoPlayback; +end; + +function Visualization(): IVideoPlayback; +begin + result := singleton_Visualization; +end; + +function AudioPlayback(): IAudioPlayback; +begin + result := singleton_AudioPlayback; +end; + +function AudioInput(): IAudioInput; +begin + result := singleton_AudioInput; +end; + +function AudioDecoder(): IAudioDecoder; +begin + result := singleton_AudioDecoder; +end; + +procedure InitializeSound; +var + lTmpInterface : IInterface; + iCount : Integer; +begin + lTmpInterface := nil; + + singleton_AudioPlayback := nil; + singleton_AudioInput := nil; + singleton_AudioDecoder := nil; + singleton_VideoPlayback := nil; + singleton_Visualization := nil; + + for iCount := 0 to AudioManager.Count - 1 do + begin + if assigned( AudioManager[iCount] ) then + begin + // if this interface is a Playback, then set it as the default used + + if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); + end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_AudioInput := IAudioInput( lTmpInterface ); + end; + + // if this interface is a Decoder, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IAudioDecoder, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_AudioDecoder := IAudioDecoder( lTmpInterface ); + end; + + // if this interface is a Input, then set it as the default used + if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); + end; + + if ( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) = 0 ) AND + ( true ) then + begin + singleton_Visualization := IVideoPlayback( lTmpInterface ); + end; + + end; + end; + + + + if VideoPlayback <> nil then + begin + end; + + if AudioDecoder <> nil then + begin + AudioDecoder.InitializeDecoder; + end; + + if AudioPlayback <> nil then + begin + AudioPlayback.InitializePlayback; + end; + + if AudioInput <> nil then + begin + AudioInput.InitializeRecord; + end; + + // Load in-game sounds + SoundLib := TSoundLibrary.Create; + + if FindCmdLineSwitch( cMediaInterfaces ) then + begin + writeln( '' ); + writeln( '--------------------------------------------------------------' ); + writeln( ' In-use Media Interfaces ' ); + writeln( '--------------------------------------------------------------' ); + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); + writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); + writeln( '--------------------------------------------------------------' ); + writeln( '' ); + + halt; + end; +end; + +constructor TSoundLibrary.Create(); +begin + //Log.LogStatus('Loading Sounds', 'Music Initialize'); + + //Log.BenchmarkStart(4); + + Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); + (* + Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); + Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); + Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); + Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); + Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); + *) + + //Drum := AudioPlayback.OpenSound(SoundPath + 'bassdrumhard076b.mp3'); + //Hihat := AudioPlayback.OpenSound(SoundPath + 'hihatclosed068b.mp3'); + //Clap := AudioPlayback.OpenSound(SoundPath + 'claps050b.mp3'); + + //Shuffle := AudioPlayback.OpenSound(SoundPath + 'Shuffle.mp3'); + + //Log.BenchmarkEnd(4); + //Log.LogBenchmark('--> Loading Sounds', 4); +end; + +destructor TSoundLibrary.Destroy(); +begin + Start.Free; + Back.Free; + Swoosh.Free; + Change.Free; + Option.Free; + Click.Free; + + //Drum.Free; + //Hihat.Free; + //Clap.Free; + + //Shuffle.Free; +end; + + +initialization +begin + singleton_AudioManager := TInterfaceList.Create(); + +end; + +finalization + singleton_AudioManager.clear; + FreeAndNil( singleton_AudioManager ); + +end. diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index ab351f6e..8ae0978a 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -1,325 +1,535 @@ -unit URecord; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes, - Math, - SysUtils, - UCommon, - UMusic, - UIni; - -// http://www.poltran.com - -type - TSound = class - BufferNew: TMemoryStream; // buffer for newest sample - BufferArray: array[1..4096] of smallint; // (Signal) newest 4096 samples - BufferLong: array of TMemoryStream; // full buffer - - Num: integer; - n: integer; // length of Signal to analyze - - // pitch detection - SzczytJest: boolean; // czy jest szczyt - pivot : integer; // Position of summit (top) on horizontal pivot - TonDokl: real; // ton aktualnego szczytu - Ton: integer; // ton bez ulamka - TonGamy: integer; // ton w gamie. wartosci: 0-11 - Skala: real; // skala FFT - - // procedures - procedure ProcessNewBuffer; - procedure AnalyzeBuffer; // use to analyze sound from buffers to get new pitch - procedure AnalyzeByAutocorrelation; // we call it to analyze sound by checking Autocorrelation - function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation - end; - - TSoundCardInput = record - Name: string; - end; - - TGenericSoundCard = class - // here can be the soundcard information - whole database from which user will select recording source - Description: string; // soundcard name/description - Input: array of TSoundCardInput; // soundcard input(-source)s - InputSelected: integer; // unused. What is this good for? - MicInput: integer; // unused. What is this good for? - //SampleRate: integer; // TODO: for sample-rate conversion (for devices that do not support 44.1kHz) - CaptureSoundLeft: TSound; // sound(-buffer) used for left channel capture data - CaptureSoundRight: TSound; // sound(-buffer) used for right channel capture data - end; - - TAudioInputProcessor = class - Sound: array of TSound; - SoundCard: array of TGenericSoundCard; - - constructor Create; - - // handle microphone input - procedure HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; - InputDevice: TGenericSoundCard); - - function volume( aChannel : byte ): byte; - end; - - smallintarray = array [0..maxInt shr 1-1] of smallInt; - psmallintarray = ^smallintarray; - - function AudioInputProcessor(): TAudioInputProcessor; - -implementation - -uses UMain; - -var - singleton_AudioInputProcessor : TAudioInputProcessor = nil; - - -// FIXME: Race-Conditions between Callback-thread and main-thread -// on BufferArray (maybe BufferNew also). -// Use SDL-mutexes to solve this problem. - - -function AudioInputProcessor(): TAudioInputProcessor; -begin +unit URecord; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, + Math, + SysUtils, + UCommon, + UMusic, + UIni; + +type + TSound = class + private + BufferNew: TMemoryStream; // buffer for newest samples + public + BufferArray: array[0..4095] of smallint; // newest 4096 samples + BufferLong: array of TMemoryStream; // full buffer + + Index: integer; // index in TAudioInputProcessor.Sound[] (TODO: Remove if not used) + + AnalysisBufferSize: integer; // number of samples to analyze + + // pitch detection + ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise) + //Peak: integer; // position of peak on horizontal pivot (TODO: Remove if not used) + //ToneAccuracy: real; // tone accuracy (TODO: Remove if not used) + Tone: integer; // TODO: should be a non-unified full range tone (e.g. C2<>C3). Range: 0..NumHalftones-1 + // Note: at the moment it is the same as ToneUnified + ToneUnified: integer; // tone unified to one octave (e.g. C2=C3=C4). Range: 0-11 + //Scale: real; // FFT scale (TODO: Remove if not used) + + // procedures + procedure ProcessNewBuffer; + procedure AnalyzeBuffer; // use to analyze sound from buffers to get new pitch + procedure AnalyzeByAutocorrelation; // we call it to analyze sound by checking Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation + end; + + TAudioInputDeviceSource = record + Name: string; + end; + + // soundcard input-devices information + TAudioInputDevice = class + public + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Description: string; // soundcard name/description + Source: array of TAudioInputDeviceSource; // soundcard input(-source)s + SourceSelected: integer; // unused. What is this good for? + MicInput: integer; // unused. What is this good for? + SampleRate: integer; // capture sample-rate (e.g. 44.1kHz -> 44100) + CaptureChannel: array[0..1] of TSound; // sound(-buffers) used for left/right channel's capture data + + procedure Start(); virtual; abstract; + procedure Stop(); virtual; abstract; + + destructor Destroy; override; + end; + + TAudioInputProcessor = class + Sound: array of TSound; + Device: array of TAudioInputDevice; + + constructor Create; + + // handle microphone input + procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; + InputDevice: TAudioInputDevice); + + function Volume( aChannel : byte ): byte; + end; + + TAudioInputBase = class( TInterfacedObject, IAudioInput ) + private + Started: boolean; + protected + function UnifyDeviceName(const name: string; deviceIndex: integer): string; + function UnifyDeviceSourceName(const name: string; const deviceName: string): string; + public + function GetName: String; virtual; abstract; + function InitializeRecord: boolean; virtual; abstract; + + procedure CaptureStart; + procedure CaptureStop; + end; + + + SmallIntArray = array [0..maxInt shr 1-1] of smallInt; + PSmallIntArray = ^SmallIntArray; + + function AudioInputProcessor(): TAudioInputProcessor; + +implementation + +uses + ULog, + UMain; + +const + CaptureFreq = 44100; + BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) + NumHalftones = 36; // C2-B4 (for Whitney and my high voice) + +var + singleton_AudioInputProcessor : TAudioInputProcessor = nil; + + +// FIXME: Race-Conditions between Callback-thread and main-thread +// on BufferArray (maybe BufferNew also). +// Use SDL-mutexes to solve this problem. + + +{ Global } + +function AudioInputProcessor(): TAudioInputProcessor; +begin if singleton_AudioInputProcessor = nil then singleton_AudioInputProcessor := TAudioInputProcessor.create(); result := singleton_AudioInputProcessor; - end; - -procedure TSound.ProcessNewBuffer; -var - S: integer; - L: integer; - A: integer; -begin - // process BufferArray - S := 0; - L := BufferNew.Size div 2; - if L > n then begin - S := L - n; - L := n; - end; - - // copy to array - for A := L+1 to n do - BufferArray[A-L] := BufferArray[A]; - - BufferNew.Seek(2*S, soBeginning); - BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L); - - // process BufferLong - if Ini.SavePlayback = 1 then - begin - BufferNew.Seek(0, soBeginning); - BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); - end; -end; - -procedure TSound.AnalyzeBuffer; -begin - AnalyzeByAutocorrelation; -end; - -procedure TSound.AnalyzeByAutocorrelation; -var - T: integer; // tone - F: real; // freq - Wages: array[0..35] of real; // wages - MaxT: integer; // max tone - MaxW: real; // max wage - V: real; // volume - MaxV: real; // max volume - S: integer; // Signal - Threshold: real; // threshold -begin - SzczytJest := false; - - // find maximum volume of first 1024 words of signal - MaxV := 0; - for S := 1 to 1024 do // 0.5.2: fix. was from 0 to 1023 - begin - V := Abs(BufferArray[S]) / $10000; - - if V > MaxV then - MaxV := V; - end; - - // prepare to analyze - MaxW := 0; - - // analyze all 12 halftones - for T := 0 to 35 do // to 11, then 23, now 35 (for Whitney and my high voice) - begin - F := 130.81 * Power(1.05946309436, T)/2; // let's analyze below 130.81 - Wages[T] := AnalyzeAutocorrelationFreq(F); - - if Wages[T] > MaxW then - begin // this frequency has better wage - MaxW := Wages[T]; - MaxT := T; - end; - end; // for T - - Threshold := 0.1; - case Ini.Threshold of - 0: Threshold := 0.05; - 1: Threshold := 0.1; - 2: Threshold := 0.15; - 3: Threshold := 0.2; - end; - - if MaxV >= Threshold then - begin // found acceptable volume // 0.1 - SzczytJest := true; - TonGamy := MaxT mod 12; - Ton := MaxT mod 12; - end; - -end; - -function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference -var - Count: real; - Src: integer; - Dst: integer; - Move: integer; - Il: integer; // how many counts were done -begin - // we use Signal as source - Count := 0; - Il := 0; - Src := 1; - Move := Round(44100/Freq); - Dst := Src + Move; - - // ver 2 - compare in vertical - while (Dst < n) do - begin // process up to n (4KB) of Signal - Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000; - Inc(Src); - Inc(Dst); - Inc(Il); - end; - - Result := 1 - Count / Il; -end; - -{* - * Handle captured microphone input data. - * Params: - * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. - * Interleaved means that a right-channel sample follows a left- - * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). - * Length - number of bytes in Buffer - * Input - Soundcard-Input used for capture - *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Length: Cardinal; InputDevice: TGenericSoundCard); -var - L: integer; - S: integer; - PB: pbytearray; - PSI: psmallintarray; - I: integer; - Skip: integer; - Boost: byte; -begin - // set boost - case Ini.MicBoost of - 0: Boost := 1; - 1: Boost := 2; - 2: Boost := 4; - 3: Boost := 8; - end; - - // boost buffer - L := Length div 2; // number of samples - PSI := Buffer; - for S := 0 to L-1 do - begin - I := PSI^[S] * Boost; - - // TODO : JB - This will clip the audio... cant we reduce the "Boot" if the data clips ?? - if I > 32767 then - I := 32767; // 0.5.0: limit - - if I < -32768 then - I := -32768; // 0.5.0: limit - - PSI^[S] := I; - end; - - // 2 players USB mic, left channel - if InputDevice.CaptureSoundLeft <> nil then - begin - L := Length div 4; // number of samples - PB := Buffer; - - InputDevice.CaptureSoundLeft.BufferNew.Clear; // 0.5.2: problem on exiting - for S := 0 to L-1 do - begin - InputDevice.CaptureSoundLeft.BufferNew.Write(PB[S*4], 2); - end; - InputDevice.CaptureSoundLeft.ProcessNewBuffer; - end; - - // 2 players USB mic, right channel - Skip := 2; - - if InputDevice.CaptureSoundRight <> nil then - begin - L := Length div 4; // number of samples - PB := Buffer; - InputDevice.CaptureSoundRight.BufferNew.Clear; - for S := 0 to L-1 do - begin - InputDevice.CaptureSoundRight.BufferNew.Write(PB[Skip + S*4], 2); - end; - InputDevice.CaptureSoundRight.ProcessNewBuffer; - end; -end; - -constructor TAudioInputProcessor.Create; -var - S: integer; -begin - SetLength(Sound, 6 {max players});//Ini.Players+1); - for S := 0 to High(Sound) do - begin //Ini.Players do begin - Sound[S] := TSound.Create; - Sound[S].Num := S; - Sound[S].BufferNew := TMemoryStream.Create; - SetLength(Sound[S].BufferLong, 1); - Sound[S].BufferLong[0] := TMemoryStream.Create; - Sound[S].n := 4*1024; - end; -end; - -function TAudioInputProcessor.volume( aChannel : byte ): byte; -var - lCount : Integer; - lMaxVol : double; -begin; - lMaxVol := AudioInputProcessor.Sound[aChannel].BufferArray[1]; - for lCount := 2 to AudioInputProcessor.Sound[aChannel].n div 1 do - begin - if AudioInputProcessor.Sound[aChannel].BufferArray[lCount] > lMaxVol then - lMaxVol := AudioInputProcessor.Sound[aChannel].BufferArray[lCount]; - end; - - result := trunc( ( 255 / 32767 ) * trunc( lMaxVol ) ); -end; - -end. - - - + + +{ TAudioInputDevice } + +destructor TAudioInputDevice.Destroy; +var + i: integer; +begin + Stop(); + Source := nil; + for i := 0 to High(CaptureChannel) do + CaptureChannel[i] := nil; + inherited Destroy; +end; + + +{ TSound } + +procedure TSound.ProcessNewBuffer; +var + SkipCount: integer; + NumSamples: integer; + SampleIndex: integer; +begin + // process BufferArray + SkipCount := 0; + NumSamples := BufferNew.Size div 2; + + // check if we have more new samples than we can store + if NumSamples > Length(BufferArray) then + begin + // discard the oldest of the new samples + SkipCount := NumSamples - Length(BufferArray); + NumSamples := Length(BufferArray); + end; + + // move old samples to the beginning of the array (if necessary) + for SampleIndex := NumSamples to High(BufferArray) do + BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex]; + + // skip samples if necessary + BufferNew.Seek(2*SkipCount, soBeginning); + // copy samples + BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples); + + // save capture-data to BufferLong if neccessary + if Ini.SavePlayback = 1 then + begin + BufferNew.Seek(0, soBeginning); + BufferLong[0].CopyFrom(BufferNew, BufferNew.Size); + end; +end; + +procedure TSound.AnalyzeBuffer; +begin + AnalyzeByAutocorrelation; +end; + +procedure TSound.AnalyzeByAutocorrelation; +var + ToneIndex: integer; + Freq: real; + Wages: array[0..NumHalftones-1] of real; + MaxTone: integer; + MaxWage: real; + Volume: real; + MaxVolume: real; + SampleIndex: integer; + Threshold: real; +const + HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave) +begin + ToneValid := false; + + // find maximum volume of first 1024 samples + MaxVolume := 0; + for SampleIndex := 0 to 1023 do + begin + Volume := Abs(BufferArray[SampleIndex]) / + -Low(Smallint); // was $10000 (65536) before but must be 32768 + + if Volume > MaxVolume then + MaxVolume := Volume; + end; + + // prepare to analyze + MaxWage := 0; + + // analyze halftones + for ToneIndex := 0 to NumHalftones-1 do + begin + Freq := BaseToneFreq * Power(HalftoneBase, ToneIndex); + Wages[ToneIndex] := AnalyzeAutocorrelationFreq(Freq); + + if Wages[ToneIndex] > MaxWage then + begin + // this frequency has better wage + MaxWage := Wages[ToneIndex]; + MaxTone := ToneIndex; + end; + end; + + Threshold := 0.2; + case Ini.Threshold of + 0: Threshold := 0.1; + 1: Threshold := 0.2; + 2: Threshold := 0.3; + 3: Threshold := 0.4; + end; + + // check if signal has an acceptable volume (ignore background-noise) + if MaxVolume >= Threshold then + begin + ToneValid := true; + ToneUnified := MaxTone mod 12; + Tone := MaxTone mod 12; + end; + +end; + +function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference +var + Dist: real; // distance (0=equal .. 1=totally different) between correlated samples + AccumDist: real; // accumulated distances + SampleIndex: integer; // index of sample to analyze + CorrelatingSampleIndex: integer; // index of sample one period ahead + SamplesPerPeriod: integer; // samples in one period +begin + SampleIndex := 0; + SamplesPerPeriod := Round(CaptureFreq/Freq); + CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod; + + AccumDist := 0; + + // compare correlating samples + while (CorrelatingSampleIndex < AnalysisBufferSize) do + begin + // calc distance (correlation: 1-dist) to corresponding sample in next period + Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) / + High(Word); // was $10000 (65536) before but must be 65535 + AccumDist := AccumDist + Dist; + Inc(SampleIndex); + Inc(CorrelatingSampleIndex); + end; + + // return "inverse" average distance (=correlation) + Result := 1 - AccumDist / AnalysisBufferSize; +end; + + +{ TAudioInputProcessor } + +{* + * Handle captured microphone input data. + * Params: + * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. + * Interleaved means that a right-channel sample follows a left- + * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). + * Length - number of bytes in Buffer + * Input - Soundcard-Input used for capture + *} +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice); +var + NumSamples: integer; // number of samples + SampleIndex: integer; + Value: integer; + ByteBuffer: PByteArray; // buffer handled as array of bytes + SampleBuffer: PSmallIntArray; // buffer handled as array of samples + Offset: integer; + Boost: byte; + ChannelCount: integer; + ChannelIndex: integer; + CaptureChannel: TSound; + SampleSize: integer; +begin + // set boost + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + end; + + // boost buffer + NumSamples := Size div 2; + SampleBuffer := Buffer; + for SampleIndex := 0 to NumSamples-1 do + begin + Value := SampleBuffer^[SampleIndex] * Boost; + + // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ?? + if Value > High(Smallint) then + Value := High(Smallint); + + if Value < Low(Smallint) then + Value := Low(Smallint); + + SampleBuffer^[SampleIndex] := Value; + end; + + // number of channels + ChannelCount := Length(InputDevice.CaptureChannel); + // size of one sample + SampleSize := ChannelCount * SizeOf(SmallInt); + // samples per channel + NumSamples := Size div SampleSize; + + // interpret buffer as buffer of bytes + ByteBuffer := Buffer; + + // process channels + for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do + begin + CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; + if (CaptureChannel <> nil) then + begin + Offset := ChannelIndex * SizeOf(SmallInt); + + // TODO: remove BufferNew and write to BufferArray directly + + CaptureChannel.BufferNew.Clear; + for SampleIndex := 0 to NumSamples-1 do + begin + CaptureChannel.BufferNew.Write(ByteBuffer^[Offset + SampleIndex*SampleSize], + SizeOf(SmallInt)); + end; + CaptureChannel.ProcessNewBuffer(); + end; + end; +end; + +constructor TAudioInputProcessor.Create; +var + i: integer; +begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for i := 0 to High(Sound) do + begin + Sound[i] := TSound.Create; + Sound[i].Index := i; + Sound[i].BufferNew := TMemoryStream.Create; + SetLength(Sound[i].BufferLong, 1); + Sound[i].BufferLong[0] := TMemoryStream.Create; + Sound[i].AnalysisBufferSize := Min(4*1024, Length(Sound[i].BufferArray)); + end; +end; + +function TAudioInputProcessor.Volume( aChannel : byte ): byte; +var + lSampleIndex: Integer; + lMaxVol : Word; +begin; + with AudioInputProcessor.Sound[aChannel] do + begin + lMaxVol := BufferArray[0]; + for lSampleIndex := 1 to High(BufferArray) do + begin + if Abs(BufferArray[lSampleIndex]) > lMaxVol then + lMaxVol := Abs(BufferArray[lSampleIndex]); + end; + end; + + result := trunc( ( 255 / -Low(Smallint) ) * lMaxVol ); +end; + + +{ TAudioInputBase } + +{* + * Start capturing on all used input-device. + *} +procedure TAudioInputBase.CaptureStart; +var + S: integer; + DeviceIndex: integer; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + DeviceUsed: boolean; + Player: integer; +begin + if (Started) then + CaptureStop(); + + Log.BenchmarkStart(1); + + // reset buffers + for S := 0 to High(AudioInputProcessor.Sound) do + AudioInputProcessor.Sound[S].BufferLong[0].Clear; + + // start capturing on each used device + for DeviceIndex := 0 to High(AudioInputProcessor.Device) do begin + Device := AudioInputProcessor.Device[DeviceIndex]; + if not assigned(Device) then + continue; + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + + DeviceUsed := false; + + // check if device is used + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; + if (Player < 0) or (Player >= PlayersPlay) then + begin + Device.CaptureChannel[ChannelIndex] := nil; + end + else + begin + Device.CaptureChannel[ChannelIndex] := AudioInputProcessor.Sound[Player]; + DeviceUsed := true; + end; + end; + + // start device if used + if (DeviceUsed) then begin + Log.BenchmarkStart(2); + Device.Start(); + Log.BenchmarkEnd(2); + Log.LogBenchmark('Device.Start', 2) ; + end; + end; + + Log.BenchmarkEnd(1); + Log.LogBenchmark('CaptureStart', 1) ; + + Started := true; +end; + +{* + * Stop input-capturing on all soundcards. + *} +procedure TAudioInputBase.CaptureStop; +var + DeviceIndex: integer; + Player: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; +begin + for DeviceIndex := 0 to High(AudioInputProcessor.Device) do begin + Device := AudioInputProcessor.Device[DeviceIndex]; + if not assigned(Device) then + continue; + Device.Stop(); + end; + + Started := false; +end; + +function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; +var + count: integer; // count of devices with this name + + function IsDuplicate(const name: string): boolean; + var + i: integer; + begin + Result := False; + // search devices with same description + For i := 0 to deviceIndex-1 do + begin + if (AudioInputProcessor.Device[i].Description = name) then + begin + Result := True; + Break; + end; + end; + end; +begin + count := 1; + result := name; + + // if there is another device with the same ID, search for an available name + while (IsDuplicate(result)) do + begin + Inc(count); + // set description + result := name + ' ('+IntToStr(count)+')'; + end; +end; + +{* + * Unifies an input-device's source name. + * Note: the description member of the device must already be set when + * calling this function. + *} +function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string; +var + Descr: string; +begin + result := name; + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then + begin + result := 'Microphone'; + end; + {$ENDIF} +end; + +end. + + + -- cgit v1.2.3 From 0cff62ed5ea1e4964817bc6efdff523f7b63342e Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 21:53:12 +0000 Subject: bugfix: ResetSingTemp prevented a song from being played twice ("File not found" error). The error is due the change of TSong from a record to a class. This is because CurrentSong = CatSongs.Song[index] won't copy the whole data anymore but just a pointer. So the paths of CatSongs.Song[index] will be set to '' too what is not desired. Jay: Please revise this. If i remember correctly you wanted to set CurrentSong to nil instead of setting the paths to an empty string. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@830 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UFiles.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index b65dcbf2..495e8a4a 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -51,6 +51,7 @@ begin Player[pet].HighNut := -1; end; + (* FIXME //Reset Path and Filename Values to Prevent Errors in Editor if assigned( CurrentSong ) then begin @@ -58,6 +59,7 @@ begin CurrentSong.Path := ''; CurrentSong.FileName := ''; end; + *) // CurrentSong := nil; end; -- cgit v1.2.3 From 68dc76576f45c5f1a68a50c7e8feb06f285297df Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 5 Feb 2008 22:09:38 +0000 Subject: mapping of keypad-enter to the return-key (for jonaspaulo and his dead key) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@833 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 2110 ++++++++++++++++++++++--------------------- 1 file changed, 1057 insertions(+), 1053 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 801a66db..7b32857b 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -1,1053 +1,1057 @@ -unit UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - UGraphic, - UMusic, - URecord, - UTime, - SysUtils, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - USong, - OpenGL12, - {$IFDEF UseSerialPort} - zlportio {you can disable it and all PortWriteB calls}, - {$ENDIF} - ULCD, - ULight, - UThemes; - -type - TPlayer = record - Name: string; - - //Index in Teaminfo record - TeamID: Byte; - PlayerID: Byte; - - //Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreI: integer; - ScoreLineI: integer; - ScoreGoldenI: integer; - ScoreTotalI: integer; - - - - //LineBonus Mod - ScoreLast: Real;//Last Line Score - - //PerfectLineTwinkle Mod (effect) - LastSentencePerfect: Boolean; - //PerfectLineTwinkle Mod end - - -// Meter: real; - - HighNut: integer; - IlNut: integer; - Nuta: array of record - Start: integer; - Dlugosc: integer; - Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute - Ton: real; - Perfect: boolean; // true if the note matches the original one, lit the star - - - - // Half size Notes Patch - Hit: boolean; // true if the note Hits the Line - //end Half size Notes Patch - - - - end; - end; - - -var - //Absolute Paths - GamePath: string; - SoundPath: string; - SongPath: string; - LogPath: string; - ThemePath: string; - SkinsPath: string; - ScreenshotsPath: string; - CoversPath: string; - LanguagesPath: string; - PluginPath: string; - PlayListPath: string; - - UserSongPath: string = ''; - UserCoversPath: string = ''; - UserPlaylistPath: string = ''; - - OGL: Boolean; - Done: Boolean; - Event: TSDL_event; - FileName: string; - Restart: boolean; - - // gracz i jego nuty - Player: array of TPlayer; - PlayersPlay: integer; - - CurrentSong : TSong; - -procedure InitializePaths; - -Procedure Main; -procedure MainLoop; -procedure CheckEvents; -procedure Sing(Sender: TScreenSing); -procedure NewSentence(Sender: TScreenSing); -procedure NewBeat(Sender: TScreenSing); // executed when on then new beat -procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click -procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection -//procedure NewHalf; // executed when in the half between beats -procedure NewNote(Sender: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - -implementation - -uses USongs, - UJoystick, - math, - UCommandLine, ULanguage, SDL_ttf, - USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, - UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; - -const - Version = 'UltraStar Deluxe V 1.10 Alpha Build'; - -Procedure Main; -var - WndTitle: string; -begin - try - - WndTitle := Version; - - if Platform.TerminateIfAlreadyRunning( {var} WndTitle) then - Exit; - - //------------------------------ - //StartUp - Create Classes and Load Files - //------------------------------ - USTime := TTime.Create; - - // Commandline Parameter Parser - Params := TCMDParams.Create; - - // Log + Benchmark - Log := TLog.Create; - Log.Title := WndTitle; - Log.Enabled := Not Params.NoLog; - Log.BenchmarkStart(0); - - // Language - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Paths', 'Initialization'); - InitializePaths; - Log.LogStatus('Load Language', 'Initialization'); - Language := TLanguage.Create; - //Add Const Values: - Language.AddConst('US_VERSION', Version); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Language', 1); - - // SDL - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL', 'Initialization'); - SDL_Init(SDL_INIT_VIDEO); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL', 1); - - // SDL_ttf - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL_ttf', 'Initialization'); - TTF_Init(); //ttf_quit(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL_ttf', 1); - - // Skin - Log.BenchmarkStart(1); - Log.LogStatus('Loading Skin List', 'Initialization'); - Skin := TSkin.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Skin List', 1); - - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - InitializeSound(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 1); - - // Ini + Paths (depends on Sound) - Log.BenchmarkStart(1); - Log.LogStatus('Load Ini', 'Initialization'); - Ini := TIni.Create; - Ini.Load; - - //Load Languagefile - if (Params.Language <> -1) then - Language.ChangeLanguage(ILanguage[Params.Language]) - else - Language.ChangeLanguage(ILanguage[Ini.Language]); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Ini', 1); - - - // LCD - Log.BenchmarkStart(1); - Log.LogStatus('Load LCD', 'Initialization'); - LCD := TLCD.Create; - if Ini.LPT = 1 then begin - // LCD.HalfInterface := true; - LCD.Enable; - LCD.Clear; - LCD.WriteText(1, ' UltraStar '); - LCD.WriteText(2, ' Loading... '); - end; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading LCD', 1); - - // Light - Log.BenchmarkStart(1); - Log.LogStatus('Load Light', 'Initialization'); - Light := TLight.Create; - if Ini.LPT = 2 then begin - Light.Enable; - end; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Light', 1); - - - - // Theme - Log.BenchmarkStart(1); - Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Themes', 1); - - // Covers Cache - Log.BenchmarkStart(1); - Log.LogStatus('Creating Covers Cache', 'Initialization'); - Covers := TCovers.Create; - Log.LogBenchmark('Loading Covers Cache Array', 1); - Log.BenchmarkStart(1); - - // Category Covers - Log.BenchmarkStart(1); - Log.LogStatus('Creating Category Covers Array', 'Initialization'); - CatCovers:= TCatCovers.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Category Covers Array', 1); - - // Songs - //Log.BenchmarkStart(1); - Log.LogStatus('Creating Song Array', 'Initialization'); - Songs := TSongs.Create; -// Songs.LoadSongList; - - Log.LogStatus('Creating 2nd Song Array', 'Initialization'); - CatSongs := TCatSongs.Create; - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Songs', 1); - - // PluginManager - Log.BenchmarkStart(1); - Log.LogStatus('PluginManager', 'Initialization'); - DLLMan := TDLLMan.Create; //Load PluginList - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PluginManager', 1); - - {// Party Mode Manager - Log.BenchmarkStart(1); - Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TPartySession.Create; //Load PartySession - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); } - - // Graphics - Log.BenchmarkStart(1); - Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WndTitle); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing 3D', 1); - - // Score Saving System - Log.BenchmarkStart(1); - Log.LogStatus('DataBase System', 'Initialization'); - DataBase := TDataBaseSystem.Create; - - if (Params.ScoreFile = '') then - DataBase.Init ('Ultrastar.db') - else - DataBase.Init (Params.ScoreFile); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading DataBase System', 1); - - //Playlist Manager - Log.BenchmarkStart(1); - Log.LogStatus('Playlist Manager', 'Initialization'); - PlaylistMan := TPlaylistManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Playlist Manager', 1); - - //GoldenStarsTwinkleMod - Log.BenchmarkStart(1); - Log.LogStatus('Effect Manager', 'Initialization'); - GoldenRec := TEffectManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Particel System', 1); - - // Joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - begin - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Joystick', 'Initialization'); - Joy := TJoy.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Joystick', 1); - end; - - Log.BenchmarkEnd(0); - Log.LogBenchmark('Loading Time', 0); - - Log.LogError('Creating Core'); - Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0))); - - Log.LogError('Running Core'); - Core.Run; - - //------------------------------ - //Start- Mainloop - //------------------------------ - //Music.SetLoop(true); - //Music.SetVolume(50); - //Music.Open(SkinPath + 'Menu Music 3.mp3'); - //Music.Play; - Log.LogStatus('Main Loop', 'Initialization'); - MainLoop; - - finally - //------------------------------ - //Finish Application - //------------------------------ - - {$ifdef WIN32} - if Ini.LPT = 1 then LCD.Clear; - if Ini.LPT = 2 then Light.TurnOff; - {$endif} - - Log.LogStatus('Main Loop', 'Finished'); - Log.Free; - end; -end; - -procedure MainLoop; -var - Delay: integer; -begin - try - Delay := 0; - SDL_EnableKeyRepeat(125, 125); - - CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - While not Done do - Begin - // joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - done := not Display.Draw; - SwapBuffers; - - // light - Light.Refresh; - - // delay - CountMidTime; - - Delay := Floor(1000 / 100 - 1000 * TimeMid); - - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - - CountSkipTime; - - // reinitialization of graphics - if Restart then - begin - Reinitialize3D; - Restart := false; - end; - - End; - - finally - UnloadOpenGL; - end; -End; - -Procedure CheckEvents; -//var -// p: pointer; -Begin - if not Assigned(Display.NextScreen) then - While SDL_PollEvent( @event ) = 1 Do - Begin -// beep; - Case Event.type_ Of - SDL_QUITEV: begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; -{ SDL_MOUSEBUTTONDOWN: - With Event.button Do - Begin - If State = SDL_BUTTON_LEFT Then - Begin - // - End; - End; // With} - SDL_KEYDOWN: - begin - //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path - if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then - Display.ScreenShot - - // popup hack... if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) - // end of popup hack - - else - begin - // check for Screen want to Exit - done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); - - //If Screen wants to Exit - if done then - begin - //If Question Option is enabled then Show Exit Popup - if (Ini.AskbeforeDel = 1) then - begin - Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); - end - else //When asking for exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - end; - - end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then - end; -// SDL_JOYAXISMOTION: -// begin -// beep -// end; - SDL_JOYBUTTONDOWN: - begin - beep - end; - End; // Case Event.type_ - End; // While -End; // CheckEvents - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(CurrentSong.BPM) = BPMNum then begin - // last BPM - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end else begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then begin - // there is still remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end else begin - // there is no remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -// TopBeat: real; -// TempBeat: real; -// TempTime: real; -begin - Result := 0; - if Length(CurrentSong.BPM) = 1 then Result := Time * CurrentSong.BPM[0].BPM / 60; - - (* 2 BPMs *) -{ if Length(CurrentSong.BPM) > 1 then begin - (* new system *) - CurBeat := 0; - TopBeat := GetBeats(CurrentSong.BPM[0].BPM, Time); - if TopBeat > CurrentSong.BPM[1].StartBeat then begin - // analyze second BPM - Time := Time - GetTimeForBeats(CurrentSong.BPM[0].BPM, CurrentSong.BPM[1].StartBeat - CurBeat); - CurBeat := CurrentSong.BPM[1].StartBeat; - TopBeat := GetBeats(CurrentSong.BPM[1].BPM, Time); - Result := CurBeat + TopBeat; - - end else begin - (* pierwszy przedzial *) - Result := TopBeat; - end; - end; // if} - - (* more BPMs *) - if Length(CurrentSong.BPM) > 1 then begin - - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end; // if -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - Result := 0; - if Length(CurrentSong.BPM) = 1 then Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; - - (* more BPMs *) - if Length(CurrentSong.BPM) > 1 then begin - Result := CurrentSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(CurrentSong.BPM)) and (Beat > CurrentSong.BPM[CurBPM].StartBeat) do begin - if (CurBPM < High(CurrentSong.BPM)) and (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then begin - // full range - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(CurrentSong.BPM)) or (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then begin - // in the middle - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (Beat - CurrentSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - -{ while (Time > 0) do begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end;} - end; // if} -end; - -procedure Sing(Sender: TScreenSing); -var - Pet: integer; - PetGr: integer; - CP: integer; - Done: real; - N: integer; -begin - Czas.Teraz := Czas.Teraz + TimeSkip; - - Czas.OldBeat := Czas.AktBeat; - Czas.MidBeat := GetMidBeat(Czas.Teraz - (CurrentSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function - Czas.AktBeat := Floor(Czas.MidBeat); - -// Czas.OldHalf := Czas.AktHalf; -// Czas.MidHalf := Czas.MidBeat + 0.5; -// Czas.AktHalf := Floor(Czas.MidHalf); - - Czas.OldBeatC := Czas.AktBeatC; - Czas.MidBeatC := GetMidBeat(Czas.Teraz - (CurrentSong.Gap) / 1000); - Czas.AktBeatC := Floor(Czas.MidBeatC); - - Czas.OldBeatD := Czas.AktBeatD; - Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (CurrentSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP - Czas.AktBeatD := Floor(Czas.MidBeatD); - Czas.FracBeatD := Frac(Czas.MidBeatD); - - // sentences routines - for PetGr := 0 to 0 do begin;//High(Gracz) do begin - CP := PetGr; - // ustawianie starej czesci - Czas.OldCzesc := Czesci[CP].Akt; - - // wybieranie aktualnej czesci - for Pet := 0 to Czesci[CP].High do - if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; - - // czysczenie nut gracza, gdy to jest nowa plansza - // (optymizacja raz na halfbeat jest zla) - if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); - - end; // for PetGr - - // wykonuje operacje raz na beat - if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then - NewBeat(Sender); - - // make some operations on clicks - if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then - NewBeatC(Sender); - - // make some operations when detecting new voice pitch - if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then - NewBeatD(Sender); - - // wykonuje operacje w polowie beatu -// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then -// NewHalf; - - // plynnie przesuwa text - Done := 1; - for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) - and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then - Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); - - N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; - - // wylacza ostatnia nute po przejsciu - {// todo: Lyrics - if (Ini.LyricsEffect = 1) and (Done = 1) and - (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) - then Sender.LyricMain.Selected := -1; - - if Done > 1 then Done := 1; - Sender.LyricMain.Done := Done; } - - // use Done with LCD -{ with ScreenSing do begin - if LyricMain.Selected >= 0 then begin - LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); - LCD.ShowCursor; - end; - end;} - - -end; - -procedure NewSentence(Sender: TScreenSing); -var -G: Integer; -begin - // czyszczenie nut graczy - for G := 0 to High(Player) do begin - Player[G].IlNut := 0; - Player[G].HighNut := -1; - SetLength(Player[G].Nuta, 0); - end; - - // Add Words to Lyrics - with Sender do begin - {LyricMain.AddCzesc(Czesci[0].Akt); - if Czesci[0].Akt < Czesci[0].High then - LyricSub.AddCzesc(Czesci[0].Akt+1) - else - LyricSub.Clear;} - while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do - Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]); - end; - - Sender.UpdateLCD; - - //On Sentence Change... - Sender.onSentenceChange(Czesci[0].Akt); -end; - -procedure NewBeat(Sender: TScreenSing); -var - Pet: integer; -// TempBeat: integer; -begin - // ustawia zaznaczenie tekstu -// SingScreen.LyricMain.Selected := -1; - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin - // operates on currently beated note - //Todo: Lyrics - //Sender.LyricMain.Selected := Pet; - -// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); -// LCD.ShowCursor; - - //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); - LCD.ShowCursor; - - end; -end; - -procedure NewBeatC; -var - Pet: integer; -// LPT_1: integer; -// LPT_2: integer; -begin -// LPT_1 := 1; -// LPT_2 := 1; - - // beat click - if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then - AudioPlayback.PlaySound(SoundLib.Click); - - // debug system on LPT - if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin - //LPT_1 := 0; -// Light.LightOne(0, 150); - - Light.LightOne(1, 200); // beat light - if ParamStr(1) = '-doublelights' then - Light.LightOne(0, 200); // beat light - - -{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then - Light.LightOne(0, 150) - else - Light.LightOne(1, 150)} - end; - - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin - // click assist - if Ini.ClickAssist = 1 then - AudioPlayback.PlaySound(SoundLib.Click); - - //LPT_2 := 0; - if ParamStr(1) <> '-doublelights' then - Light.LightOne(0, 150); //125 - - - // drum machine -(* TempBeat := Czas.AktBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; -// if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) - end; - - {$IFDEF UseSerialPort} - // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala - {$ENDIF} -end; - -procedure NewBeatD(Sender: TScreenSing); -begin - NewNote(Sender); -end; - -//procedure NewHalf; -//begin -// NewNote; -//end; - -procedure NewNote(Sender: TScreenSing); -var - CP: integer; // current player - S: integer; // sentence - SMin: integer; - SMax: integer; - SDet: integer; // temporary: sentence of detected note - Pet: integer; - Mozna: boolean; - Nowa: boolean; - Range: integer; - NoteHit:boolean; -begin -// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); -// beep; - - // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas - if not assigned( AudioInputProcessor.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. - exit; - - // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) - // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do - begin - - // analyze buffer - AudioInputProcessor.Sound[CP].AnalyzeBuffer; - - // adds some noise -// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; - - // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SMin := Czesci[0].Akt-1; - if SMin < 0 then SMin := 0; - SMax := Czesci[0].Akt; - - // check if we can add new note - Mozna := false; - SDet:=SMin; - for S := SMin to SMax do - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) - and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 - then begin - SDet := S; - Mozna := true; - Break; - end; - - S := SDet; - - - - - -// Czas.SzczytJest := true; -// Czas.Ton := 27; - - // gdy moze, to dodaje nute - if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then begin - // operowanie na ostatniej nucie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) - and (Czesci[0].Czesc[S].Nuta[Pet].Start + - Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin - // to robi, tylko dla pary nut (oryginalnej i gracza) - - // przesuwanie tonu w odpowiednia game - while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do - AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12; - - while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do - AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone + 12; - - // Half size Notes Patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Tone) <= Range then begin - AudioInputProcessor.Sound[CP].Tone := Czesci[0].Czesc[S].Nuta[Pet].Ton; - - - // Half size Notes Patch - NoteHit := true; - - - if (Ini.LineBonus = 0) then - begin - // add points without LineBonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end - else - begin - // add points with Line Bonus - case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of - 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * - Czesci[0].Czesc[S].Nuta[Pet].Wartosc; - end; - end; - - Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; - Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; - - Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; - end; - - end; // operowanie - - // sprawdzanie czy to nowa nuta, czy przedluzenie - if S = SMax then begin - Nowa := true; - // jezeli ostatnia ma ten sam ton - if (Player[CP].IlNut > 0 ) - and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Tone) - and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) - then Nowa := false; - // jezeli jest jakas nowa nuta na sprawdzanym beacie - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then - Nowa := true; - - // dodawanie nowej nuty - if Nowa then begin - // nowa nuta - Player[CP].IlNut := Player[CP].IlNut + 1; - Player[CP].HighNut := Player[CP].HighNut + 1; - SetLength(Player[CP].Nuta, Player[CP].IlNut); - Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; - Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl - Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; - - - // Half Note Patch - Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; - - - // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); - - end else begin - // przedluzenie nuty - Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; - end; - - - // check for perfect note and then lit the star (on Draw) - for Pet := 0 to Czesci[0].Czesc[S].HighNut do - if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) - and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) - and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin - Player[CP].Nuta[Player[CP].HighNut].Perfect := true; - end; - - end;// else beep; // if S = SMax - - end; // if moze - end; // for CP -// Log.LogStatus('EndBeat', 'NewBeat'); - -//On Sentence End -> For LineBonus + SingBar -if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then -if assigned( Sender ) AND - ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then - Sender.onSentenceEnd(sDet); - -end; - -procedure ClearScores(PlayerNum: integer); -begin - Player[PlayerNum].Score := 0; - Player[PlayerNum].ScoreI := 0; - Player[PlayerNum].ScoreLine := 0; - Player[PlayerNum].ScoreLineI := 0; - Player[PlayerNum].ScoreGolden := 0; - Player[PlayerNum].ScoreGoldenI := 0; - Player[PlayerNum].ScoreTotalI := 0; -end; - - -//-------------------- -// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist -//-------------------- -procedure InitializePaths; - - // Initialize a Path Variable - // After Setting Paths, make sure that Paths exist - function initialize_path( out aPathVar : String; const aLocation : String ): boolean; - var - lWriteable: Boolean; - lAttrib : integer; - begin - lWriteable := false; - aPathVar := aLocation; - - // Make sure the directory is needex - ForceDirectories(aPathVar); - - If DirectoryExists(aPathVar) then - begin - lAttrib := fileGetAttr(aPathVar); - - lWriteable := ( lAttrib and faDirectory <> 0 ) AND - NOT ( lAttrib and faReadOnly <> 0 ) - end; - - if not lWriteable then - Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); - - result := lWriteable; - end; - -begin - - initialize_path( LogPath , Platform.GetLogPath ); - initialize_path( SoundPath , Platform.GetGameSharedPath + 'Sounds' + PathDelim ); - initialize_path( ThemePath , Platform.GetGameSharedPath + 'Themes' + PathDelim ); - initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim ); - initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim ); - initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim ); - - initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim ); - - // Users Song Path .... - initialize_path( UserSongPath , Platform.GetGameUserPath + 'Songs' + PathDelim ); - initialize_path( UserCoversPath , Platform.GetGameUserPath + 'Covers' + PathDelim ); - initialize_path( UserPlaylistPath , Platform.GetGameUserPath + 'Playlists' + PathDelim ); - - // Shared Song Path .... - initialize_path( SongPath , Platform.GetGameSharedPath + 'Songs' + PathDelim ); - initialize_path( CoversPath , Platform.GetGameSharedPath + 'Covers' + PathDelim ); - initialize_path( PlaylistPath , Platform.GetGameSharedPath + 'Playlists' + PathDelim ); - - DecimalSeparator := ','; -end; - -end. - +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphic, + UMusic, + URecord, + UTime, + SysUtils, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + USong, + OpenGL12, + {$IFDEF UseSerialPort} + zlportio {you can disable it and all PortWriteB calls}, + {$ENDIF} + ULCD, + ULight, + UThemes; + +type + TPlayer = record + Name: string; + + //Index in Teaminfo record + TeamID: Byte; + PlayerID: Byte; + + //Scores + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreI: integer; + ScoreLineI: integer; + ScoreGoldenI: integer; + ScoreTotalI: integer; + + + + //LineBonus Mod + ScoreLast: Real;//Last Line Score + + //PerfectLineTwinkle Mod (effect) + LastSentencePerfect: Boolean; + //PerfectLineTwinkle Mod end + + +// Meter: real; + + HighNut: integer; + IlNut: integer; + Nuta: array of record + Start: integer; + Dlugosc: integer; + Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute + Ton: real; + Perfect: boolean; // true if the note matches the original one, lit the star + + + + // Half size Notes Patch + Hit: boolean; // true if the note Hits the Line + //end Half size Notes Patch + + + + end; + end; + + +var + //Absolute Paths + GamePath: string; + SoundPath: string; + SongPath: string; + LogPath: string; + ThemePath: string; + SkinsPath: string; + ScreenshotsPath: string; + CoversPath: string; + LanguagesPath: string; + PluginPath: string; + PlayListPath: string; + + UserSongPath: string = ''; + UserCoversPath: string = ''; + UserPlaylistPath: string = ''; + + OGL: Boolean; + Done: Boolean; + Event: TSDL_event; + FileName: string; + Restart: boolean; + + // gracz i jego nuty + Player: array of TPlayer; + PlayersPlay: integer; + + CurrentSong : TSong; + +procedure InitializePaths; + +Procedure Main; +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Sender: TScreenSing); +procedure NewSentence(Sender: TScreenSing); +procedure NewBeat(Sender: TScreenSing); // executed when on then new beat +procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click +procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection +//procedure NewHalf; // executed when in the half between beats +procedure NewNote(Sender: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation + +uses USongs, + UJoystick, + math, + UCommandLine, ULanguage, SDL_ttf, + USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager, + UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform; + +const + Version = 'UltraStar Deluxe V 1.10 Alpha Build'; + +Procedure Main; +var + WndTitle: string; +begin + try + + WndTitle := Version; + + if Platform.TerminateIfAlreadyRunning( {var} WndTitle) then + Exit; + + //------------------------------ + //StartUp - Create Classes and Load Files + //------------------------------ + USTime := TTime.Create; + + // Commandline Parameter Parser + Params := TCMDParams.Create; + + // Log + Benchmark + Log := TLog.Create; + Log.Title := WndTitle; + Log.Enabled := Not Params.NoLog; + Log.BenchmarkStart(0); + + // Language + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Paths', 'Initialization'); + InitializePaths; + Log.LogStatus('Load Language', 'Initialization'); + Language := TLanguage.Create; + //Add Const Values: + Language.AddConst('US_VERSION', Version); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Language', 1); + + // SDL + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL', 'Initialization'); + SDL_Init(SDL_INIT_VIDEO); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL', 1); + + // SDL_ttf + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL_ttf', 'Initialization'); + TTF_Init(); //ttf_quit(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL_ttf', 1); + + // Skin + Log.BenchmarkStart(1); + Log.LogStatus('Loading Skin List', 'Initialization'); + Skin := TSkin.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Skin List', 1); + + // Sound + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + + // Ini + Paths (depends on Sound) + Log.BenchmarkStart(1); + Log.LogStatus('Load Ini', 'Initialization'); + Ini := TIni.Create; + Ini.Load; + + //Load Languagefile + if (Params.Language <> -1) then + Language.ChangeLanguage(ILanguage[Params.Language]) + else + Language.ChangeLanguage(ILanguage[Ini.Language]); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Ini', 1); + + + // LCD + Log.BenchmarkStart(1); + Log.LogStatus('Load LCD', 'Initialization'); + LCD := TLCD.Create; + if Ini.LPT = 1 then begin + // LCD.HalfInterface := true; + LCD.Enable; + LCD.Clear; + LCD.WriteText(1, ' UltraStar '); + LCD.WriteText(2, ' Loading... '); + end; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading LCD', 1); + + // Light + Log.BenchmarkStart(1); + Log.LogStatus('Load Light', 'Initialization'); + Light := TLight.Create; + if Ini.LPT = 2 then begin + Light.Enable; + end; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Light', 1); + + + + // Theme + Log.BenchmarkStart(1); + Log.LogStatus('Load Themes', 'Initialization'); + Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Themes', 1); + + // Covers Cache + Log.BenchmarkStart(1); + Log.LogStatus('Creating Covers Cache', 'Initialization'); + Covers := TCovers.Create; + Log.LogBenchmark('Loading Covers Cache Array', 1); + Log.BenchmarkStart(1); + + // Category Covers + Log.BenchmarkStart(1); + Log.LogStatus('Creating Category Covers Array', 'Initialization'); + CatCovers:= TCatCovers.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Category Covers Array', 1); + + // Songs + //Log.BenchmarkStart(1); + Log.LogStatus('Creating Song Array', 'Initialization'); + Songs := TSongs.Create; +// Songs.LoadSongList; + + Log.LogStatus('Creating 2nd Song Array', 'Initialization'); + CatSongs := TCatSongs.Create; + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Songs', 1); + + // PluginManager + Log.BenchmarkStart(1); + Log.LogStatus('PluginManager', 'Initialization'); + DLLMan := TDLLMan.Create; //Load PluginList + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PluginManager', 1); + + {// Party Mode Manager + Log.BenchmarkStart(1); + Log.LogStatus('PartySession Manager', 'Initialization'); + PartySession := TPartySession.Create; //Load PartySession + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PartySession Manager', 1); } + + // Graphics + Log.BenchmarkStart(1); + Log.LogStatus('Initialize 3D', 'Initialization'); + Initialize3D(WndTitle); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing 3D', 1); + + // Score Saving System + Log.BenchmarkStart(1); + Log.LogStatus('DataBase System', 'Initialization'); + DataBase := TDataBaseSystem.Create; + + if (Params.ScoreFile = '') then + DataBase.Init ('Ultrastar.db') + else + DataBase.Init (Params.ScoreFile); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading DataBase System', 1); + + //Playlist Manager + Log.BenchmarkStart(1); + Log.LogStatus('Playlist Manager', 'Initialization'); + PlaylistMan := TPlaylistManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Playlist Manager', 1); + + //GoldenStarsTwinkleMod + Log.BenchmarkStart(1); + Log.LogStatus('Effect Manager', 'Initialization'); + GoldenRec := TEffectManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Particel System', 1); + + // Joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + begin + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Joystick', 'Initialization'); + Joy := TJoy.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Joystick', 1); + end; + + Log.BenchmarkEnd(0); + Log.LogBenchmark('Loading Time', 0); + + Log.LogError('Creating Core'); + Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0))); + + Log.LogError('Running Core'); + Core.Run; + + //------------------------------ + //Start- Mainloop + //------------------------------ + //Music.SetLoop(true); + //Music.SetVolume(50); + //Music.Open(SkinPath + 'Menu Music 3.mp3'); + //Music.Play; + Log.LogStatus('Main Loop', 'Initialization'); + MainLoop; + + finally + //------------------------------ + //Finish Application + //------------------------------ + + {$ifdef WIN32} + if Ini.LPT = 1 then LCD.Clear; + if Ini.LPT = 2 then Light.TurnOff; + {$endif} + + Log.LogStatus('Main Loop', 'Finished'); + Log.Free; + end; +end; + +procedure MainLoop; +var + Delay: integer; +begin + try + Delay := 0; + SDL_EnableKeyRepeat(125, 125); + + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. + While not Done do + Begin + // joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // light + Light.Refresh; + + // delay + CountMidTime; + + Delay := Floor(1000 / 100 - 1000 * TimeMid); + + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + + CountSkipTime; + + // reinitialization of graphics + if Restart then + begin + Reinitialize3D; + Restart := false; + end; + + End; + + finally + UnloadOpenGL; + end; +End; + +Procedure CheckEvents; +//var +// p: pointer; +Begin + if not Assigned(Display.NextScreen) then + While SDL_PollEvent( @event ) = 1 Do + Begin +// beep; + Case Event.type_ Of + SDL_QUITEV: begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; +{ SDL_MOUSEBUTTONDOWN: + With Event.button Do + Begin + If State = SDL_BUTTON_LEFT Then + Begin + // + End; + End; // With} + SDL_KEYDOWN: + begin + // remap the "keypad enter" key to the "standard enter" key + if (Event.key.keysym.sym = SDLK_KP_ENTER) then + Event.key.keysym.sym := SDLK_RETURN; + + //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path + if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then + Display.ScreenShot + + // popup hack... if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> NIL) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + else if (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + // end of popup hack + + else + begin + // check for Screen want to Exit + done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + + //If Screen wants to Exit + if done then + begin + //If Question Option is enabled then Show Exit Popup + if (Ini.AskbeforeDel = 1) then + begin + Display.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX'); + end + else //When asking for exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then + end; +// SDL_JOYAXISMOTION: +// begin +// beep +// end; + SDL_JOYBUTTONDOWN: + begin + beep + end; + End; // Case Event.type_ + End; // While +End; // CheckEvents + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(CurrentSong.BPM) = BPMNum then begin + // last BPM + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end else begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then begin + // there is still remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end else begin + // there is no remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +// TopBeat: real; +// TempBeat: real; +// TempTime: real; +begin + Result := 0; + if Length(CurrentSong.BPM) = 1 then Result := Time * CurrentSong.BPM[0].BPM / 60; + + (* 2 BPMs *) +{ if Length(CurrentSong.BPM) > 1 then begin + (* new system *) + CurBeat := 0; + TopBeat := GetBeats(CurrentSong.BPM[0].BPM, Time); + if TopBeat > CurrentSong.BPM[1].StartBeat then begin + // analyze second BPM + Time := Time - GetTimeForBeats(CurrentSong.BPM[0].BPM, CurrentSong.BPM[1].StartBeat - CurBeat); + CurBeat := CurrentSong.BPM[1].StartBeat; + TopBeat := GetBeats(CurrentSong.BPM[1].BPM, Time); + Result := CurBeat + TopBeat; + + end else begin + (* pierwszy przedzial *) + Result := TopBeat; + end; + end; // if} + + (* more BPMs *) + if Length(CurrentSong.BPM) > 1 then begin + + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end; // if +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + Result := 0; + if Length(CurrentSong.BPM) = 1 then Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; + + (* more BPMs *) + if Length(CurrentSong.BPM) > 1 then begin + Result := CurrentSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(CurrentSong.BPM)) and (Beat > CurrentSong.BPM[CurBPM].StartBeat) do begin + if (CurBPM < High(CurrentSong.BPM)) and (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then begin + // full range + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(CurrentSong.BPM)) or (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then begin + // in the middle + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * (Beat - CurrentSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + +{ while (Time > 0) do begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end;} + end; // if} +end; + +procedure Sing(Sender: TScreenSing); +var + Pet: integer; + PetGr: integer; + CP: integer; + Done: real; + N: integer; +begin + Czas.Teraz := Czas.Teraz + TimeSkip; + + Czas.OldBeat := Czas.AktBeat; + Czas.MidBeat := GetMidBeat(Czas.Teraz - (CurrentSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function + Czas.AktBeat := Floor(Czas.MidBeat); + +// Czas.OldHalf := Czas.AktHalf; +// Czas.MidHalf := Czas.MidBeat + 0.5; +// Czas.AktHalf := Floor(Czas.MidHalf); + + Czas.OldBeatC := Czas.AktBeatC; + Czas.MidBeatC := GetMidBeat(Czas.Teraz - (CurrentSong.Gap) / 1000); + Czas.AktBeatC := Floor(Czas.MidBeatC); + + Czas.OldBeatD := Czas.AktBeatD; + Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (CurrentSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP + Czas.AktBeatD := Floor(Czas.MidBeatD); + Czas.FracBeatD := Frac(Czas.MidBeatD); + + // sentences routines + for PetGr := 0 to 0 do begin;//High(Gracz) do begin + CP := PetGr; + // ustawianie starej czesci + Czas.OldCzesc := Czesci[CP].Akt; + + // wybieranie aktualnej czesci + for Pet := 0 to Czesci[CP].High do + if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet; + + // czysczenie nut gracza, gdy to jest nowa plansza + // (optymizacja raz na halfbeat jest zla) + if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender); + + end; // for PetGr + + // wykonuje operacje raz na beat + if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then + NewBeat(Sender); + + // make some operations on clicks + if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then + NewBeatC(Sender); + + // make some operations when detecting new voice pitch + if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then + NewBeatD(Sender); + + // wykonuje operacje w polowie beatu +// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then +// NewHalf; + + // plynnie przesuwa text + Done := 1; + for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat) + and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then + Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc); + + N := Czesci[0].Czesc[Czesci[0].Akt].HighNut; + + // wylacza ostatnia nute po przejsciu + {// todo: Lyrics + if (Ini.LyricsEffect = 1) and (Done = 1) and + (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc) + then Sender.LyricMain.Selected := -1; + + if Done > 1 then Done := 1; + Sender.LyricMain.Done := Done; } + + // use Done with LCD +{ with ScreenSing do begin + if LyricMain.Selected >= 0 then begin + LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done)); + LCD.ShowCursor; + end; + end;} + + +end; + +procedure NewSentence(Sender: TScreenSing); +var +G: Integer; +begin + // czyszczenie nut graczy + for G := 0 to High(Player) do begin + Player[G].IlNut := 0; + Player[G].HighNut := -1; + SetLength(Player[G].Nuta, 0); + end; + + // Add Words to Lyrics + with Sender do begin + {LyricMain.AddCzesc(Czesci[0].Akt); + if Czesci[0].Akt < Czesci[0].High then + LyricSub.AddCzesc(Czesci[0].Akt+1) + else + LyricSub.Clear;} + while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do + Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]); + end; + + Sender.UpdateLCD; + + //On Sentence Change... + Sender.onSentenceChange(Czesci[0].Akt); +end; + +procedure NewBeat(Sender: TScreenSing); +var + Pet: integer; +// TempBeat: integer; +begin + // ustawia zaznaczenie tekstu +// SingScreen.LyricMain.Selected := -1; + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin + // operates on currently beated note + //Todo: Lyrics + //Sender.LyricMain.Selected := Pet; + +// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter); +// LCD.ShowCursor; + + //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter); + LCD.ShowCursor; + + end; +end; + +procedure NewBeatC; +var + Pet: integer; +// LPT_1: integer; +// LPT_2: integer; +begin +// LPT_1 := 1; +// LPT_2 := 1; + + // beat click + if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then + AudioPlayback.PlaySound(SoundLib.Click); + + // debug system on LPT + if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin + //LPT_1 := 0; +// Light.LightOne(0, 150); + + Light.LightOne(1, 200); // beat light + if ParamStr(1) = '-doublelights' then + Light.LightOne(0, 200); // beat light + + +{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then + Light.LightOne(0, 150) + else + Light.LightOne(1, 150)} + end; + + for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin + // click assist + if Ini.ClickAssist = 1 then + AudioPlayback.PlaySound(SoundLib.Click); + + //LPT_2 := 0; + if ParamStr(1) <> '-doublelights' then + Light.LightOne(0, 150); //125 + + + // drum machine +(* TempBeat := Czas.AktBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; +// if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat;*) + end; + + {$IFDEF UseSerialPort} + // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala + {$ENDIF} +end; + +procedure NewBeatD(Sender: TScreenSing); +begin + NewNote(Sender); +end; + +//procedure NewHalf; +//begin +// NewNote; +//end; + +procedure NewNote(Sender: TScreenSing); +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Pet: integer; + Mozna: boolean; + Nowa: boolean; + Range: integer; + NoteHit:boolean; +begin +// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat'); +// beep; + + // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas + if not assigned( AudioInputProcessor.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago.. + exit; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do + begin + + // analyze buffer + AudioInputProcessor.Sound[CP].AnalyzeBuffer; + + // adds some noise +// Czas.Ton := Czas.Ton + Round(Random(3)) - 1; + + // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Czesci[0].Akt-1; + if SMin < 0 then SMin := 0; + SMax := Czesci[0].Akt; + + // check if we can add new note + Mozna := false; + SDet:=SMin; + for S := SMin to SMax do + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD)) + and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1 + then begin + SDet := S; + Mozna := true; + Break; + end; + + S := SDet; + + + + + +// Czas.SzczytJest := true; +// Czas.Ton := 27; + + // gdy moze, to dodaje nute + if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then begin + // operowanie na ostatniej nucie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1) + and (Czesci[0].Czesc[S].Nuta[Pet].Start + + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12; + + while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Tone) <= Range then begin + AudioInputProcessor.Sound[CP].Tone := Czesci[0].Czesc[S].Nuta[Pet].Ton; + + + // Half size Notes Patch + NoteHit := true; + + + if (Ini.LineBonus = 0) then + begin + // add points without LineBonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end + else + begin + // add points with Line Bonus + case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of + 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc * + Czesci[0].Czesc[S].Nuta[Pet].Wartosc; + end; + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then begin + Nowa := true; + // jezeli ostatnia ma ten sam ton + if (Player[CP].IlNut > 0 ) + and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Tone) + and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD) + then Nowa := false; + // jezeli jest jakas nowa nuta na sprawdzanym beacie + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then + Nowa := true; + + // dodawanie nowej nuty + if Nowa then begin + // nowa nuta + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNut := Player[CP].HighNut + 1; + SetLength(Player[CP].Nuta, Player[CP].IlNut); + Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD; + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1; + Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl + Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat; + + + // Half Note Patch + Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit; + + + // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat'); + + end else begin + // przedluzenie nuty + Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1; + end; + + + // check for perfect note and then lit the star (on Draw) + for Pet := 0 to Czesci[0].Czesc[S].HighNut do + if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start) + and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc) + and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin + Player[CP].Nuta[Player[CP].HighNut].Perfect := true; + end; + + end;// else beep; // if S = SMax + + end; // if moze + end; // for CP +// Log.LogStatus('EndBeat', 'NewBeat'); + +//On Sentence End -> For LineBonus + SingBar +if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then +if assigned( Sender ) AND + ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then + Sender.onSentenceEnd(sDet); + +end; + +procedure ClearScores(PlayerNum: integer); +begin + Player[PlayerNum].Score := 0; + Player[PlayerNum].ScoreI := 0; + Player[PlayerNum].ScoreLine := 0; + Player[PlayerNum].ScoreLineI := 0; + Player[PlayerNum].ScoreGolden := 0; + Player[PlayerNum].ScoreGoldenI := 0; + Player[PlayerNum].ScoreTotalI := 0; +end; + + +//-------------------- +// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist +//-------------------- +procedure InitializePaths; + + // Initialize a Path Variable + // After Setting Paths, make sure that Paths exist + function initialize_path( out aPathVar : String; const aLocation : String ): boolean; + var + lWriteable: Boolean; + lAttrib : integer; + begin + lWriteable := false; + aPathVar := aLocation; + + // Make sure the directory is needex + ForceDirectories(aPathVar); + + If DirectoryExists(aPathVar) then + begin + lAttrib := fileGetAttr(aPathVar); + + lWriteable := ( lAttrib and faDirectory <> 0 ) AND + NOT ( lAttrib and faReadOnly <> 0 ) + end; + + if not lWriteable then + Log.LogError('Error: Dir ('+ aLocation +') is Readonly'); + + result := lWriteable; + end; + +begin + + initialize_path( LogPath , Platform.GetLogPath ); + initialize_path( SoundPath , Platform.GetGameSharedPath + 'Sounds' + PathDelim ); + initialize_path( ThemePath , Platform.GetGameSharedPath + 'Themes' + PathDelim ); + initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim ); + initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim ); + initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim ); + + initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim ); + + // Users Song Path .... + initialize_path( UserSongPath , Platform.GetGameUserPath + 'Songs' + PathDelim ); + initialize_path( UserCoversPath , Platform.GetGameUserPath + 'Covers' + PathDelim ); + initialize_path( UserPlaylistPath , Platform.GetGameUserPath + 'Playlists' + PathDelim ); + + // Shared Song Path .... + initialize_path( SongPath , Platform.GetGameSharedPath + 'Songs' + PathDelim ); + initialize_path( CoversPath , Platform.GetGameSharedPath + 'Covers' + PathDelim ); + initialize_path( PlaylistPath , Platform.GetGameSharedPath + 'Playlists' + PathDelim ); + + DecimalSeparator := ','; +end; + +end. + -- cgit v1.2.3 From e0f79449eedac343fbac90b72b7a6792e8e940e9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 6 Feb 2008 09:59:51 +0000 Subject: fixed the configure stuff though it needs some further adjustments git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@835 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index b962d8a5..fe4bbf11 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -43,7 +43,8 @@ uses {$ELSE} oldlinux, {$ENDIF} - SysUtils; + SysUtils, + UConfig; {$IFDEF FPC_VERSION_2_2_0_PLUS} Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; @@ -137,7 +138,11 @@ begin if FindCmdLineSwitch( cUseLocalPaths ) then result := ExtractFilePath(ParamStr(0)) else - result := '/var/log/UltraStarDeluxe/'; +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := LogPath+'/'; +{$ENDIF} end; function TPlatformLinux.GetGameSharedPath : WideString; @@ -145,7 +150,11 @@ begin if FindCmdLineSwitch( cUseLocalPaths ) then result := ExtractFilePath(ParamStr(0)) else - result := '/usr/share/UltraStarDeluxe/'; +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := SharedPath+'/'; +{$ENDIF} end; function TPlatformLinux.GetGameUserPath : WideString; @@ -153,7 +162,11 @@ begin if FindCmdLineSwitch( cUseLocalPaths ) then result := ExtractFilePath(ParamStr(0)) else - result := get_homedir()+'/.UltraStarDeluxe/'; +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := get_homedir()+'/.'+PathSuffix+'/'; +{$ENDIF} end; function TPlatformLinux.get_homedir(): string; -- cgit v1.2.3 From 51a8b92b1696c8ff27523de753a7c6a743a817de Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 7 Feb 2008 18:38:51 +0000 Subject: Audio output working again git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@838 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioInput_Portaudio.pas | 6 ------ Game/Code/Classes/UAudioPlayback_Portaudio.pas | 2 +- Game/Code/Classes/UMusic.pas | 2 -- 3 files changed, 1 insertion(+), 9 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UAudioInput_Portaudio.pas b/Game/Code/Classes/UAudioInput_Portaudio.pas index c969a1b3..753c69f6 100644 --- a/Game/Code/Classes/UAudioInput_Portaudio.pas +++ b/Game/Code/Classes/UAudioInput_Portaudio.pas @@ -191,25 +191,20 @@ const begin result := false; - writeln('0'); - err := Pa_Initialize(); if(err <> paNoError) then begin Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); Exit; end; - writeln('1'); apiIndex := GetPreferredApiIndex(); apiInfo := Pa_GetHostApiInfo(apiIndex); SC := 0; - writeln('2'); // init array-size to max. input-devices count SetLength(AudioInputProcessor.Device, apiInfo^.deviceCount); for i:= 0 to High(AudioInputProcessor.Device) do begin - writeln('25'); // convert API-specific device-index to global index deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); deviceInfo := Pa_GetDeviceInfo(deviceIndex); @@ -303,7 +298,6 @@ begin Inc(SC); end; - writeln('3'); // adjust size to actual input-device count SetLength(AudioInputProcessor.Device, SC); diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index 2743fa86..59571d3d 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -411,7 +411,7 @@ begin playback := TAudioPlayback_Portaudio(userdata); with playback do begin - //MixerStream.ReadData(stream, len); + MixerStream.ReadData(stream, len); end; end; diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index 27ab86e1..b06e226d 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -444,13 +444,11 @@ begin //Log.BenchmarkStart(4); Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); - (* Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); - *) //Drum := AudioPlayback.OpenSound(SoundPath + 'bassdrumhard076b.mp3'); //Hihat := AudioPlayback.OpenSound(SoundPath + 'hihatclosed068b.mp3'); -- cgit v1.2.3 From d4d3d8873fea024cd9e1f17b04416bebe627d1f0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 7 Feb 2008 19:52:50 +0000 Subject: SWScale will only be used if FFMpeg is available (this should be the standard case) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@839 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UConfig.pas | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UConfig.pas b/Game/Code/Classes/UConfig.pas index 51e9348e..a7b0f328 100644 --- a/Game/Code/Classes/UConfig.pas +++ b/Game/Code/Classes/UConfig.pas @@ -67,8 +67,19 @@ uses Sysutils; const - // include config-file + // IMPORTANT: + // If IncludeConstants is defined, the const-sections + // of the config-file will be included too. + // This switch is necessary because it is not possible to + // include the const-sections in the switches.inc. + // switches.inc is always included before the first uses- + // section but at that place no const-section is allowed. + // So we have to include the config-file in switches.inc + // with IncludeConstants undefined and in UConfig.pas with + // IncludeConstants defined (see the note above). {$DEFINE IncludeConstants} + + // include config-file (defines + constants) {$IF Defined(MSWindows)} {$I ../config-win.inc} {$ELSEIF Defined(Linux)} @@ -139,14 +150,14 @@ const (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - {$IFDEF HaveSWScale} LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); {$ENDIF} - + + {$ENDIF} + {$IFDEF HaveProjectM} PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + (PROJECTM_VERSION_MINOR * VERSION_MINOR) + -- cgit v1.2.3 From 9e696510eb04ce60cbfb8fa88629c66a9384c0f2 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 12 Feb 2008 10:30:58 +0000 Subject: UVisualizer uses the system dependant default game-path now git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@843 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMain.pas | 4 +++- Game/Code/Classes/UVisualizer.pas | 35 +++++++++++++++++++++++++++-------- 2 files changed, 30 insertions(+), 9 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 7b32857b..bbd4a5ee 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -92,6 +92,7 @@ var CoversPath: string; LanguagesPath: string; PluginPath: string; + VisualsPath: string; PlayListPath: string; UserSongPath: string = ''; @@ -1034,9 +1035,10 @@ begin initialize_path( LogPath , Platform.GetLogPath ); initialize_path( SoundPath , Platform.GetGameSharedPath + 'Sounds' + PathDelim ); initialize_path( ThemePath , Platform.GetGameSharedPath + 'Themes' + PathDelim ); - initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim ); + initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim ); initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim ); initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim ); + initialize_path( VisualsPath , Platform.GetGameSharedPath + 'Visuals' + PathDelim ); initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim ); diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas index 22c168a2..2f584299 100644 --- a/Game/Code/Classes/UVisualizer.pas +++ b/Game/Code/Classes/UVisualizer.pas @@ -36,6 +36,7 @@ implementation uses UGraphic, + UMain, ULog; var @@ -46,10 +47,15 @@ const gy = 24; fps = 30; texsize = 512; - visualsDir = 'Visuals'; // TODO: move this to a place common for all visualizers - projectMDir = visualsDir+'/projectM'; - presetsDir = projectMDir+'/presets'; - fontsDir = projectMDir+'/fonts'; + +var + ProjectMPath : string; + presetsDir : string; + fontsDir : string; + + // FIXME: dirty fix needed because the init method is not + // called yet. + inited: boolean; type TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) @@ -78,8 +84,8 @@ type procedure RestoreOpenGLState(); public - constructor create(); - procedure init(); + constructor Create(); + procedure Init(); function GetName: String; function Open( aFileName : string): boolean; // true if succeed @@ -97,14 +103,22 @@ type end; -constructor TVideoPlayback_ProjectM.create(); +constructor TVideoPlayback_ProjectM.Create(); begin RndPCMcount := 0; end; -procedure TVideoPlayback_ProjectM.init(); +procedure TVideoPlayback_ProjectM.Init(); begin + // FIXME: dirty fix needed because the init method is not + // called yet. + inited := true; + + ProjectMPath := VisualsPath + 'projectM' + PathDelim; + presetsDir := ProjectMPath + 'presets'; + fontsDir := ProjectMPath + 'fonts'; + VisualizerStarted := False; VisualizerPaused := False; @@ -212,6 +226,11 @@ procedure TVideoPlayback_ProjectM.VisualizerStart; var initResult: Cardinal; begin + // FIXME: dirty fix needed because the init method is not + // called yet. + if (not inited) then + Init(); + VisualizerStarted := True; pm := TProjectM.Create(gx, gy, fps, texsize, ScreenW, ScreenH, -- cgit v1.2.3 From 00b2331d0b1a08651374c56cce898f501a2d5104 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 12 Feb 2008 12:18:57 +0000 Subject: changed InitializeSound to be responsive to failed module initializations, and to remove the module and try again. EG... in my case, sound card driver problems. ALSA is installed but wouldnt open the audio device. now it fails, and the output module goes to the next available ( if there is any ) then gracefully fails to dummy. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@845 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UMusic.pas | 53 ++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 14 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index b06e226d..8bbd297a 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -341,18 +341,14 @@ begin result := singleton_AudioDecoder; end; -procedure InitializeSound; +procedure AssignSingletonObjects(); var lTmpInterface : IInterface; iCount : Integer; begin lTmpInterface := nil; + - singleton_AudioPlayback := nil; - singleton_AudioInput := nil; - singleton_AudioDecoder := nil; - singleton_VideoPlayback := nil; - singleton_Visualization := nil; for iCount := 0 to AudioManager.Count - 1 do begin @@ -361,34 +357,34 @@ begin // if this interface is a Playback, then set it as the default used if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND - ( true ) then + ( true ) then //not assigned( singleton_AudioPlayback ) ) then begin singleton_AudioPlayback := IAudioPlayback( lTmpInterface ); end; // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND - ( true ) then + ( true ) then //not assigned( singleton_AudioInput ) ) then begin singleton_AudioInput := IAudioInput( lTmpInterface ); end; // if this interface is a Decoder, then set it as the default used if ( AudioManager[iCount].QueryInterface( IAudioDecoder, lTmpInterface ) = 0 ) AND - ( true ) then + ( true ) then //not assigned( singleton_AudioDecoder ) ) then begin singleton_AudioDecoder := IAudioDecoder( lTmpInterface ); end; // if this interface is a Input, then set it as the default used if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND - ( true ) then + ( true ) then //not assigned( singleton_VideoPlayback ) ) then begin singleton_VideoPlayback := IVideoPlayback( lTmpInterface ); end; if ( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) = 0 ) AND - ( true ) then + ( true ) then //not assigned( singleton_Visualization ) ) then begin singleton_Visualization := IVideoPlayback( lTmpInterface ); end; @@ -396,6 +392,17 @@ begin end; end; +end; + +procedure InitializeSound; +begin + singleton_AudioPlayback := nil; + singleton_AudioInput := nil; + singleton_AudioDecoder := nil; + singleton_VideoPlayback := nil; + singleton_Visualization := nil; + + AssignSingletonObjects(); if VideoPlayback <> nil then @@ -404,17 +411,35 @@ begin if AudioDecoder <> nil then begin - AudioDecoder.InitializeDecoder; + while not AudioDecoder.InitializeDecoder do + begin + //writeln('Initialize failed, Removing - '+ AudioDecoder.GetName ); + AudioManager.remove( AudioDecoder ); + singleton_AudioDecoder := nil; + AssignSingletonObjects(); + end; end; if AudioPlayback <> nil then begin - AudioPlayback.InitializePlayback; + while not AudioPlayback.InitializePlayback do + begin + writeln('Initialize failed, Removing - '+ AudioPlayback.GetName ); + AudioManager.remove( AudioPlayback ); + singleton_AudioPlayback := nil; + AssignSingletonObjects(); + end; end; if AudioInput <> nil then begin - AudioInput.InitializeRecord; + while not AudioInput.InitializeRecord do + begin + writeln('Initialize failed, Removing - '+ AudioInput.GetName ); + AudioManager.remove( AudioInput ); + singleton_AudioInput := nil; + AssignSingletonObjects(); + end; end; // Load in-game sounds -- cgit v1.2.3 From c63d80995c2c618b9cd293d9eecd3eb9e0e9b871 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 12 Feb 2008 13:43:34 +0000 Subject: builds nice... and builds deb also that runs / works .. mostly :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@846 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UPlatformLinux.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas index fe4bbf11..0883b0f8 100644 --- a/Game/Code/Classes/UPlatformLinux.pas +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -143,6 +143,9 @@ begin {$ELSE} result := LogPath+'/'; {$ENDIF} + + forcedirectories( result ); + end; function TPlatformLinux.GetGameSharedPath : WideString; -- cgit v1.2.3 From 699dde3fa949b1920fd1e721e3f244b8b33b3eb1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 13 Feb 2008 12:03:47 +0000 Subject: added USNG Song path , so we can use songs that a USNG install may have. dodgey implementation, but not important at the moment. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@847 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USongs.pas | 1779 +++++++++++++++++++++--------------------- 1 file changed, 893 insertions(+), 886 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 97e8d073..b502f703 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -1,886 +1,893 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF DARWIN} - {$IFDEF DEBUG} - {$DEFINE USE_PSEUDO_THREAD} - {$ENDIF} -{$ENDIF} - -uses - {$IFDEF MSWINDOWS} - Windows, - DirWatch, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - USong, - UCatCovers; - -type - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - - {$IFDEF USE_PSEUDO_THREAD} - TSongs = class( TPseudoThread ) - {$ELSE} - TSongs = class( TThread ) - {$ENDIF} - private - fNotify , - fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; - {$ifdef MSWINDOWS} - fDirWatch : TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public -// Song : array of TSong; // array of songs - SongList : TList; // array of songs - Selected : integer; // selected song index - constructor create(); - destructor destroy(); override; - - - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; - end; - - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure Refresh; // refreshes arrays by recreating them from Songs array -// procedure Sort(Order: integer); - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: String; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; - -{$IFDEF DARWIN} -function AnsiContainsText(const AText, ASubText: string): Boolean; -begin - Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; -end; -{$ENDIF} - -constructor TSongs.create(); -begin - // do not start thread BEFORE initialization (suspended = true) - inherited create( true ); - self.freeonterminate := true; - - SongList := TList.create(); - - {$ifdef MSWINDOWS} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - {$IFDEF linux} - (* - Thankyou to : http://www.linuxjournal.com/article/8478 - http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch - *) -(* - fNotify := -1; - fWatch := -1; - - writeln( 'Calling inotify_init' ); - fNotify := Do_SysCall( syscall_nr_inotify_init ); - if ( fNotify < 0 ) then - writeln( 'Filesystem change notification - disabled' ); - writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); - - writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); - fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); - - if (fWatch < 0) then - writeln ('inotify_add_watch'); - writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); -*) - {$endif} - - // now we can start the thread - Resume(); -end; - -destructor TSongs.destroy(); -begin - freeandnil( SongList ); -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify : THandle; -begin -{$IFDEF USE_PSEUDO_THREAD} - int_LoadSongList(); -{$ELSE} - fParseSongDirectory := true; - - while not self.terminated do - begin - - if fParseSongDirectory then - begin - writeln( 'int_LoadSongList' ); - int_LoadSongList(); - end; - - self.suspend; - end; -{$ENDIF} -end; - -procedure TSongs.int_LoadSongList; -begin - try - fProcessing := true; - - Log.LogError('SongList', 'Searching For Songs'); - - // browse directories - BrowseDir(SongPath); - - if UserSongPath <> SongPath then - BrowseDir(UserSongPath); - - if assigned( CatSongs ) then - CatSongs.Refresh; - - if assigned( CatCovers ) then - CatCovers.Load; - - if assigned( Covers ) then - Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - finally - Log.LogError('SongList', 'Search Complete'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - self.resume; -end; - -procedure TSongs.BrowseDir(Dir: widestring); -var - i : Integer; - Files : TDirectoryEntryArray; - lSong : TSong; -begin - - Files := Platform.DirectoryFindFiles( Dir, '.txt', true); - - for i := 0 to Length(Files)-1 do - begin - if Files[i].IsDirectory then - begin - BrowseDir( Dir + Files[i].Name + PathDelim ); - end - else - begin - lSong := TSong.create( Dir + Files[i].Name ); - - if NOT lSong.Analyse then - begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); - end - else - begin - SongList.add( lSong ); - end; - - end; - end; - SetLength( Files, 0); -end; - -procedure TSongs.Sort(Order: integer); -var - S: integer; - S2: integer; - TempSong: TSong; -begin - case Order of - sEdition: // by edition - begin - for S2 := 0 to SongList.Count -1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sGenre: // by genre - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sTitle: // by title - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - - end; - sArtist: // by artist - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sFolder: // by folder - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sTitle2: // by title2 - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - - end; - sArtist2: // by artist2 - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then - begin - // zamiana miejscami - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - sLanguage: // by Language - begin - for S2 := 0 to SongList.Count-1 do - for S := 1 to SongList.Count-1 do - if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then - begin - TempSong := SongList[S-1]; - SongList[S-1] := SongList[S]; - SongList[S] := TempSong; - end; - end; - - end; // case -end; - -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.Refresh; -var - S: integer; // temporary song index - CatLen: integer; // length of CatSongs.Song - Letter: char; // current letter for sorting using letter - SS: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - Letter2: char; // - CatNumber:integer; // Number of Song in Category -begin - CatNumShow := -1; -// Songs.Sort(0); // by title - -case Ini.Sorting of - sEdition: begin - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: Songs.Sort(sTitle); - sArtist: Songs.Sort(sArtist); - sTitle2: Songs.Sort(sTitle2); // by title2 - sArtist2: Songs.Sort(sArtist2); // by artist2 - - end; // case - - - Letter := ' '; - SS := ''; - Order := 0; - CatNumber := 0; - - //Songs leeren - SetLength (Song, 0); - - for S := 0 to Songs.SongList.Count-1 do - begin - if (Ini.Tabs = 1) then - if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin - // add Category Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Edition; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + SS + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - - - // 0.4.3 - // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; - // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; - // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; - // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; - // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; - // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} - - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin - // add Genre Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Genre; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin - // add Language Button - Inc(Order); - SS := TSong( Songs.SongList[S] ).Language; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle) and - (Length(TSong( Songs.SongList[S] ).Title)>=1) and - (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and - (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin - // add a letter Category Button - Inc(Order); - Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin - // 0.5.0: add folder tab - Inc(Order); - SS := TSong( Songs.SongList[S] ).Folder; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := SS; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); - - //CatNumber Patch - if (SS <> '') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end - - else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin - if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end - - else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin - if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; - if (Letter <> Letter2) then begin - // add a letter Category Button - Inc(Order); - Letter := Letter2; - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; - CatSongs.Song[CatLen].Main := true; - CatSongs.Song[CatLen].OrderTyp := 0; -// Order := ord(Letter); - CatSongs.Song[CatLen].OrderNum := Order; - - {// cover-patch - if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' - else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} - CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); - - //CatNumber Patch - if (Letter <> ' ') then - begin - Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy - CatNumber := 0; - end; - - CatSongs.Song[CatLen].Visible := true; - end; - end; - - - CatLen := Length(CatSongs.Song); - SetLength(CatSongs.Song, CatLen+1); - - Inc (CatNumber); //Increase Number in Cat - - CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); - CatSongs.Song[CatLen].OrderNum := Order; // assigns category - CatSongs.Song[CatLen].CatNumber := CatNumber; - - if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true - else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; -// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab -//CatSongs.Song[CatLen].Visible := true; - - end; -//CatNumber Patch - Set CatNumber of Last Category -if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then - Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy -//CatCount Patch -CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin - if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - //Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do begin - if CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false - end; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: Integer; - begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; - end; -//Wrong song selected when tabs on bug End - -function TCatSongs.VisibleSongs: integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to high(CatSongs.Song) do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.VisibleIndex(Index: integer): integer; -var - S: integer; // song -begin - Result := 0; - for S := 0 to Index-1 do - if CatSongs.Song[S].Visible = true then Inc(Result); -end; - -function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; -var - I, J: Integer; - cString: String; - SearchStr: Array of String; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - While (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') AND (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') AND (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - For J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else begin - for i:=0 to High(Song) do begin - Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - - - -// ----------------------------------------------------------------------------- - - - - -end. +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF DARWIN} + {$IFDEF DEBUG} + {$DEFINE USE_PSEUDO_THREAD} + {$ENDIF} +{$ENDIF} + +uses + {$IFDEF MSWINDOWS} + Windows, + DirWatch, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + USong, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + + {$IFDEF USE_PSEUDO_THREAD} + TSongs = class( TPseudoThread ) + {$ELSE} + TSongs = class( TThread ) + {$ENDIF} + private + fNotify , + fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef MSWINDOWS} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public +// Song : array of TSong; // array of songs + SongList : TList; // array of songs + Selected : integer; // selected song index + constructor create(); + destructor destroy(); override; + + + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: String; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} + +constructor TSongs.create(); +begin + // do not start thread BEFORE initialization (suspended = true) + inherited create( true ); + self.freeonterminate := true; + + SongList := TList.create(); + + {$ifdef MSWINDOWS} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + // now we can start the thread + Resume(); +end; + +destructor TSongs.destroy(); +begin + freeandnil( SongList ); +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin +{$IFDEF USE_PSEUDO_THREAD} + int_LoadSongList(); +{$ELSE} + fParseSongDirectory := true; + + while not self.terminated do + begin + + if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; +{$ENDIF} +end; + +procedure TSongs.int_LoadSongList; +const + cUSNGPath = '/usr/share/games/ultrastar-ng/songs'; +begin + try + fProcessing := true; + + Log.LogError('SongList', 'Searching For Songs'); + + // browse directories + BrowseDir(SongPath); + + if UserSongPath <> SongPath then + BrowseDir(UserSongPath); + + if ( cUSNGPath <> SongPath ) AND + ( cUSNGPath <> UserSongPath ) then + BrowseDir( cUSNGPath ); // todo : JB this is REAL messy, + // we should have some sort of path manager that lets us specify X number of extra paths to search + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + if assigned( Covers ) then + Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + finally + Log.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; +end; + +procedure TSongs.BrowseDir(Dir: widestring); +var + i : Integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseDir( Dir + Files[i].Name + PathDelim ); + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if NOT lSong.Analyse then + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end + else + begin + SongList.add( lSong ); + end; + + end; + end; + SetLength( Files, 0); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to SongList.Count -1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then + begin + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + + end; // case +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := 0 to Songs.SongList.Count-1 do + begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and + (Length(TSong( Songs.SongList[S] ).Title)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := TSong( Songs.SongList[S] ).Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin + if (CatSongs.Song[S].OrderNum = Index) AND (Not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + //Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: Integer; + begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; + end; +//Wrong song selected when tabs on bug End + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.SetFilter(FilterStr: String; const fType: Byte): Cardinal; +var + I, J: Integer; + cString: String; + SearchStr: Array of String; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + While (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') AND (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') AND (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + For J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible AND AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else begin + for i:=0 to High(Song) do begin + Song[i].Visible:=(Ini.Tabs=1)=Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + + + +// ----------------------------------------------------------------------------- + + + + +end. -- cgit v1.2.3 From 0c8777a5798a39dee058cbdd713bd095bff8c9a0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 13 Feb 2008 12:08:19 +0000 Subject: Fixed popUpBg image not displaying in game. this was not so much a problem with loading this type of texture, more so it was the fact that the file name had incorrect capitialization in the theme.ini file causing the png file to be not found on *nix systems. Ive implemented a workaround that will solve this without the theme files needing to be changed. so the game is now tolerant of themes having incorrect case in the filenames. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@849 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/USkins.pas | 8 +- Game/Code/Classes/UTexture.pas | 2319 ++++++++++++++++++++-------------------- 2 files changed, 1180 insertions(+), 1147 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 6a022153..e6056ee4 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -143,8 +143,12 @@ begin end; end; - Log.LogStatus('', '-----------------------------------------'); - Log.LogStatus(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); + if ( TextureName <> '' ) AND + ( Result <> '' ) THEN + begin + Log.LogError('', '-----------------------------------------'); + Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); + end; { Result := SkinPath + 'Bar.jpg'; if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 770b88bd..deff8b94 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1145 +1,1174 @@ -unit UTexture; -// added for easier debug disabling -{$undef blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - X: real; - Y: real; - Z: real; // new - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // used? - TexH: real; // used? - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - end; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - function LoadImage(Identifier: PChar): PSDL_Surface; - function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; - procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); - function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; - procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); - procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - - public - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// TextureD8: array[1..1024*1024] of byte; // 1MB - TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) -// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) -// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) -// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - StrUtils, dialogs; - -const - fmt_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); - fmt_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); - - -Constructor TTextureUnit.Create; -begin - inherited Create; -end; - -Destructor TTextureUnit.Destroy; -begin - inherited Destroy; -end; - -function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result:=True - else - Result:=False; -end; - -// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ - 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; -// ----------------------------------------------- - -function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_rgb; - - - if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then - begin - TempSurface:=TexSurface; - TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - Result:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); -end; - -procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - TexSurface:=SDL_ScaleSurfaceRect(TempSurface, - 0,0,TempSurface^.W,TempSurface^.H, - W,H); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface:=TexSurface; - with TempSurface^.format^ do - TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); - SDL_SetAlpha(TexSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface,nil,TexSurface,nil); - SDL_FreeSurface(TempSurface); -end; - -procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); - //returns hue within range [0.0-6.0) - function col2h(Color:Cardinal):double; - var - clr,hls: array[0..2] of double; - delta: double; - begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - // this is for safety reasons - if delta = 0.0 then delta:=0.000000000001; - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; - end; - procedure ColorizePixel(Pix: PByteArray; hue: Double); - var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; - begin - hls[0]:=hue; - - clr[0] := Pix[0]/255; - clr[1] := Pix[1]/255; - clr[2] := Pix[2]/255; - - //calculate luminance and saturation from rgb - hls[1] := maxvalue(clr); //l:=... - delta := hls[1] - minvalue(clr); - - if hls[1] = 0.0 then - hls[2] := 0.0 - else - hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) - // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - DestinationHue:=col2h(Col); - for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do - ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: Cardinal; -begin - Log.BenchmarkStart(4); - Mipmapping := true; -(* - Log.LogStatus( '', '' ); - - if Identifier = nil then - Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') - else - Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); -*) - - // load texture data into memory - {$ifdef blindydebug} - Log.LogStatus('',' ----------------------------------------------------'); - Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - - // convert pixel format as needed - {$ifdef blindydebug} - Log.LogStatus('',' AdjustPixelFormat'); - {$endif} - AdjustPixelFormat(TexSurface, Typ); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ScaleTexture'); - {$endif} - ScaleTexture(TexSurface,newWidth,newHeight); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : typ='+Typ); - {$endif} - - - - // don't actually understand, if this is needed... - // this should definately be changed... together with all this - // cover cache stuff - if (CreateCacheMipmap) and (Typ='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - if assigned(MipmapSurface) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' BlitSurface Stuff'); - {$endif} - // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - end - else - begin - Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); - end; - end; - // should i create a cache texture, if Covers.W/H are larger? - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-2'); - {$endif} - - - // now we might colorize the whole thing - if Typ='Colorized' then - ColorizeTexture(TexSurface,Col); - - // save actual dimensions of our texture - oldWidth:=newWidth; - oldHeight:=newHeight; - // make texture dimensions be powers of 2 - newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); - newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitTexture(TexSurface,newWidth,newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - {$ifdef blindydebug} - Log.LogStatus('',' JB-3'); - {$endif} - - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - - // JB_linux : this is causing AV's on linux... ActText seems to be nil ! -// {$IFnDEF win32} -// if pointer(ActTex) = nil then -// exit; -// {$endif} - - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - if Typ = 'Transparent Range' then - // set alpha to 256-green-component (not sure) - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TexNewW + Position2+1, 1] := Pix; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; -} -{ - if Typ = 'Font' then - // either create luminance-alpha texture - // or use transparency from differently saved file - // or do something totally different (text engine with ttf) - Pix := PPix[Position2 * 3]; - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' then - begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end; - end; - - if Typ = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - Result.X := 0; - Result.Y := 0; - Result.Z := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - Result.Name := Identifier; - - SDL_FreeSurface(TexSurface); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-7'); - {$endif} - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - - if Name = '' then - exit; - - // find texture entry - T := FindTexture(Name); - - if T = -1 then - begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; - end; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then - begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$ifdef blindydebug} - Log.LogStatus('done',' '); - {$endif} - end; - - // use texture - Result := TextureDatabase.Texture[T].Texture; - end; - - if FromCache and Covers.CoverExists(Name) then - begin - // use cache texture - C := Covers.CoverNumber(Name); - - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); - end; - - // use texture - Result := TextureDatabase.Texture[T].TextureCache; - end; -end; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -end; - -function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; -begin - Result := LoadTexture(false, Identifier, Format, Typ, Col); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; -var - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; -begin - Mipmapping := false; - - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then beep; - end; - - Result.X := 0; - Result.Y := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - // 0.5.0 - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end else begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$undef blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$ifdef FPC} + fileutil, + {$endif} + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result:=True + else + Result:=False; +end; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; + + function FileExistsInsensative( var aFileName : PChar ): boolean; + begin +{$IFDEF fpc} + result := true; + + if FileExists( aFileName ) then + exit; + + aFileName := pchar( FindDiskFileCaseInsensitive( aFileName ) ); + result := FileExists( aFileName ); +{$ELSE} + result := FileExists( aFileName ); +{$ENDIF} + end; + +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + + lFileName : pchar; + +begin + Result := nil; + TexRWops := nil; + + if Identifier = '' then + exit; + + lFileName := Identifier; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + Log.LogStatus( 'Looking for File ( Loading : '+Identifier+' - '+ FindDiskFileCaseInsensitive(Identifier) +')', ' LoadImage' ); + + if ( FileExistsInsensative(lFileName) ) then + begin + // load from file + Log.LogStatus( 'Is File ( Loading : '+lFileName+')', ' LoadImage' ); + try + Result:=IMG_Load(lFileName); + Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : typ='+Typ); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(TexSurface,Col); + + // save actual dimensions of our texture + oldWidth:=newWidth; + oldHeight:=newHeight; + // make texture dimensions be powers of 2 + newWidth:=Round(Power(2, Ceil(Log2(newWidth)))); + newHeight:=Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitTexture(TexSurface,newWidth,newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} + + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + Result.X := 0; + Result.Y := 0; + Result.Z := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end else begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3