diff options
Diffstat (limited to 'Game')
-rw-r--r-- | Game/Code/Classes/TextGL.pas | 780 | ||||
-rw-r--r-- | Game/Code/Classes/UCommon.pas | 26 | ||||
-rw-r--r-- | Game/Code/Classes/UGraphic.pas | 26 | ||||
-rw-r--r-- | Game/Code/Classes/USkins.pas | 335 | ||||
-rw-r--r-- | Game/Code/Classes/UTexture.pas | 250 | ||||
-rw-r--r-- | Game/Code/Menu/UMenu.pas | 18 | ||||
-rw-r--r-- | Game/Code/UltraStar.lpr | 835 |
7 files changed, 1224 insertions, 1046 deletions
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.
diff --git a/Game/Code/Menu/UMenu.pas b/Game/Code/Menu/UMenu.pas index ccce325e..16bc4ab2 100644 --- a/Game/Code/Menu/UMenu.pas +++ b/Game/Code/Menu/UMenu.pas @@ -287,15 +287,23 @@ begin end;
procedure TMenu.AddBackground(Name: string);
+var
+ lFileName : string;
begin
if Name <> '' then
begin
// BackImg := Texture.LoadTexture(false, PChar(Skin.SkinPath + FileName), 'JPG', 'Plain', 0); // new theme system
- BackImg := Texture.GetTexture(Skin.GetTextureFileName(Name), 'Plain');
- BackImg.W := 800;
- BackImg.H := 600;
- BackW := 1;
- BackH := 1;
+ lFileName := Skin.GetTextureFileName(Name);
+
+ if lFileName <> '' then
+ begin
+ BackImg := Texture.GetTexture( lFileName , 'Plain');
+
+ BackImg.W := 800;
+ BackImg.H := 600;
+ BackW := 1;
+ BackH := 1;
+ end;
end;
end;
diff --git a/Game/Code/UltraStar.lpr b/Game/Code/UltraStar.lpr index 67d4d9da..802fb4e5 100644 --- a/Game/Code/UltraStar.lpr +++ b/Game/Code/UltraStar.lpr @@ -1,416 +1,419 @@ -program UltraStar; - -{$DEFINE TRANSLATE} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ELSE} - {$R 'UltraStar.res' 'UltraStar.rc'} -{$ENDIF} - -{$I switches.inc} - -uses - - // *************************************************************************** - // - // Developers PLEASE NOTE !!!!!!! - // - // As of september 2007, I am working towards porting Ultrastar-DX to run - // on Linux. I will be modifiying the source to make it compile in lazarus - // on windows & linux and I will make sure that it compiles in delphi still - // To help me in this endevour, please can you make a point of remembering - // that linux is CASE SENSATIVE, and file / unit names must be as per - // the filename exactly. - // - // EG : opengl12.pas must not be OpenGL in the uses cluase. - // - // thanks for your help... - // - // *************************************************************************** - - //------------------------------ - //Includes - 3rd Party Libraries - //------------------------------ - - // SDL / OpenGL - moduleloader in 'lib\JEDI-SDLv1.0\SDL\Pas\moduleloader.pas', - opengl12 in 'lib\JEDI-SDLv1.0\OpenGL\Pas\opengl12.pas', - sdl in 'lib\JEDI-SDLv1.0\SDL\Pas\sdl.pas', - sdl_image in 'lib\JEDI-SDLv1.0\SDL_Image\Pas\sdl_image.pas', - - // Bass - {$IFDEF UseBASS} - bass in 'lib\bass\delphi\bass.pas', - {$ENDIF} - - // Midi Units - {$IFDEF UseMIDIPort} - Circbuf in 'lib\midi\CIRCBUF.PAS', - Delphmcb in 'lib\midi\Delphmcb.PAS', - MidiCons in 'lib\midi\MidiCons.PAS', - MidiDefs in 'lib\midi\MidiDefs.PAS', - MidiFile in 'lib\midi\MidiFile.PAS', - midiin in 'lib\midi\midiin.pas', - midiout in 'lib\midi\midiout.pas', - MidiType in 'lib\midi\MidiType.PAS', - {$ENDIF} - - // FFMpeg units - avcodec in 'lib\ffmpeg\avcodec.pas', - avformat in 'lib\ffmpeg\avformat.pas', - avio in 'lib\ffmpeg\avio.pas', - avutil in 'lib\ffmpeg\avutil.pas', - opt in 'lib\ffmpeg\opt.pas', - rational in 'lib\ffmpeg\rational.pas', - - - // Sql Lite - SQLiteTable3 in 'lib\SQLite\SQLiteTable3.pas', - SQLite3 in 'lib\SQLite\SQLite3.pas', - - - //------------------------------ - //Includes - Menu System - //------------------------------ - - UDisplay in 'Menu\UDisplay.pas', - UDrawTexture in 'Menu\UDrawTexture.pas', - UMenu in 'Menu\UMenu.pas', - UMenuButton in 'Menu\UMenuButton.pas', - UMenuButtonCollection in 'Menu\UMenuButtonCollection.pas', - UMenuInteract in 'Menu\UMenuInteract.pas', - UMenuSelect in 'Menu\UMenuSelect.pas', - UMenuSelectSlide in 'Menu\UMenuSelectSlide.pas', - UMenuStatic in 'Menu\UMenuStatic.pas', - UMenuText in 'Menu\UMenuText.pas', - - //------------------------------ - //Includes - Classes - //------------------------------ - - {$IFDEF FPC} - ulazjpeg in 'Classes\ulazjpeg.pas', - {$ENDIF} - - TextGL in 'Classes\TextGL.pas', - UCatCovers in 'Classes\UCatCovers.pas', - UCommandLine in 'Classes\UCommandLine.pas', - UCommon in 'Classes\UCommon.pas', - UCovers in 'Classes\UCovers.pas', - UDataBase in 'Classes\UDataBase.pas', - UDLLManager in 'Classes\UDLLManager.pas', - UDraw in 'Classes\UDraw.pas', - UFiles in 'Classes\UFiles.pas', - UGraphic in 'Classes\UGraphic.pas', - UGraphicClasses in 'Classes\UGraphicClasses.pas', - UIni in 'Classes\UIni.pas', - UJoystick in 'Classes\UJoystick.pas', - ULanguage in 'Classes\ULanguage.pas', - ULCD in 'Classes\ULCD.pas', - ULight in 'Classes\ULight.pas', - ULog in 'Classes\ULog.pas', - ULyrics in 'Classes\ULyrics.pas', - ULyrics_bak in 'Classes\ULyrics_bak.pas', - UMain in 'Classes\UMain.pas', - UMusic in 'Classes\UMusic.pas', - UParty in 'Classes\UParty.pas', - UPlaylist in 'Classes\UPlaylist.pas', - URecord in 'Classes\URecord.pas', - USkins in 'Classes\USkins.pas', - USongs in 'Classes\USongs.pas', - UTexture in 'Classes\UTexture.pas', - UThemes in 'Classes\UThemes.pas', - UTime in 'Classes\UTime.pas', - - - //------------------------------ - //Includes - Video Support - //------------------------------ - UVideo in 'Classes\UVideo.pas', - - - //------------------------------ - //Includes - Screens - //------------------------------ - UScreenCredits in 'Screens\UScreenCredits.pas', - UScreenEdit in 'Screens\UScreenEdit.pas', - UScreenEditConvert in 'Screens\UScreenEditConvert.pas', - UScreenEditHeader in 'Screens\UScreenEditHeader.pas', - UScreenEditSub in 'Screens\UScreenEditSub.pas', - UScreenLevel in 'Screens\UScreenLevel.pas', - UScreenLoading in 'Screens\UScreenLoading.pas', - UScreenMain in 'Screens\UScreenMain.pas', - UScreenName in 'Screens\UScreenName.pas', - UScreenOpen in 'Screens\UScreenOpen.pas', - UScreenOptions in 'Screens\UScreenOptions.pas', - UScreenOptionsAdvanced in 'Screens\UScreenOptionsAdvanced.pas', - UScreenOptionsGame in 'Screens\UScreenOptionsGame.pas', - UScreenOptionsGraphics in 'Screens\UScreenOptionsGraphics.pas', - UScreenOptionsLyrics in 'Screens\UScreenOptionsLyrics.pas', - UScreenOptionsRecord in 'Screens\UScreenOptionsRecord.pas', - UScreenOptionsSound in 'Screens\UScreenOptionsSound.pas', - UScreenOptionsThemes in 'Screens\UScreenOptionsThemes.pas', - UScreenPopup in 'Screens\UScreenPopup.pas', - UScreenScore in 'Screens\UScreenScore.pas', - UScreenSing in 'Screens\UScreenSing.pas', - UScreenSong in 'Screens\UScreenSong.pas', - UScreenSongJumpto in 'Screens\UScreenSongJumpto.pas', - UScreenSongMenu in 'Screens\UScreenSongMenu.pas', - UScreenStatDetail in 'Screens\UScreenStatDetail.pas', - UScreenStatMain in 'Screens\UScreenStatMain.pas', - UScreenTop5 in 'Screens\UScreenTop5.pas', - UScreenWelcome in 'Screens\UScreenWelcome.pas', - - //------------------------------ - //Includes - Screens PartyMode - //------------------------------ - UScreenPartyNewRound in 'Screens\UScreenPartyNewRound.pas', - UScreenPartyOptions in 'Screens\UScreenPartyOptions.pas', - UScreenPartyPlayer in 'Screens\UScreenPartyPlayer.pas', - UScreenPartyScore in 'Screens\UScreenPartyScore.pas', - UScreenPartyWin in 'Screens\UScreenPartyWin.pas', - UScreenSingModi in 'Screens\UScreenSingModi.pas', - - //------------------------------ - //Includes - Modi SDK - //------------------------------ - ModiSDK in '..\..\Modis\SDK\ModiSDK.pas', - - - //------------------------------ - //Includes - Delphi - //------------------------------ - {$IFDEF win32} - Windows, - {$ENDIF} - SysUtils; - -const - Version = 'UltraStar Deluxe V 1.10 Alpha Build'; - -var - WndTitle: string; - hWnd: THandle; - I: Integer; - -begin - WndTitle := Version; - - {$ifdef Win32} - //------------------------------ - //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. Contìnue ?'), 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); - - // 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); - - // Graphics - Log.BenchmarkStart(1); - Log.LogStatus('Initialize 3D', 'Initialization'); Initialize3D(WndTitle); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing 3D', 1); - - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - Log.LogStatus('Creating Music', 'InitializeSound'); Music := TMusic.Create; - InitializeSound; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 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); - - - //------------------------------ - //Start- Mainloop - //------------------------------ - //Music.SetLoop(true); - //Music.SetVolume(50); - //Music.Open(SkinPath + 'Menu Music 3.mp3'); - //Music.Play; - Log.LogStatus('Main Loop', 'Initialization'); MainLoop; - - Log.LogStatus('Cleanup', 'Done'); - - //------------------------------ - //Finish Application - //------------------------------ - if Ini.LPT = 1 then LCD.Clear; - if Ini.LPT = 2 then Light.TurnOff; - - Log.Free; -end. +program UltraStar;
+
+{$DEFINE TRANSLATE}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ELSE}
+ {$R 'UltraStar.res' 'UltraStar.rc'}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+
+ // ***************************************************************************
+ //
+ // Developers PLEASE NOTE !!!!!!!
+ //
+ // As of september 2007, I am working towards porting Ultrastar-DX to run
+ // on Linux. I will be modifiying the source to make it compile in lazarus
+ // on windows & linux and I will make sure that it compiles in delphi still
+ // To help me in this endevour, please can you make a point of remembering
+ // that linux is CASE SENSATIVE, and file / unit names must be as per
+ // the filename exactly.
+ //
+ // EG : opengl12.pas must not be OpenGL in the uses cluase.
+ //
+ // thanks for your help...
+ //
+ // ***************************************************************************
+
+ //------------------------------
+ //Includes - 3rd Party Libraries
+ //------------------------------
+
+ // SDL / OpenGL
+ moduleloader in 'lib\JEDI-SDLv1.0\SDL\Pas\moduleloader.pas',
+ opengl12 in 'lib\JEDI-SDLv1.0\OpenGL\Pas\opengl12.pas',
+ sdl in 'lib\JEDI-SDLv1.0\SDL\Pas\sdl.pas',
+ sdl_image in 'lib\JEDI-SDLv1.0\SDL_Image\Pas\sdl_image.pas',
+ sdlutils in 'lib\JEDI-SDLv1.0\SDL\Pas\sdlutils.pas',
+
+
+ // Bass
+ {$IFDEF UseBASS}
+ bass in 'lib\bass\delphi\bass.pas',
+ {$ENDIF}
+
+ // Midi Units
+ {$IFDEF UseMIDIPort}
+ Circbuf in 'lib\midi\CIRCBUF.PAS',
+ Delphmcb in 'lib\midi\Delphmcb.PAS',
+ MidiCons in 'lib\midi\MidiCons.PAS',
+ MidiDefs in 'lib\midi\MidiDefs.PAS',
+ MidiFile in 'lib\midi\MidiFile.PAS',
+ midiin in 'lib\midi\midiin.pas',
+ midiout in 'lib\midi\midiout.pas',
+ MidiType in 'lib\midi\MidiType.PAS',
+ {$ENDIF}
+
+ // FFMpeg units
+ avcodec in 'lib\ffmpeg\avcodec.pas',
+ avformat in 'lib\ffmpeg\avformat.pas',
+ avio in 'lib\ffmpeg\avio.pas',
+ avutil in 'lib\ffmpeg\avutil.pas',
+ opt in 'lib\ffmpeg\opt.pas',
+ rational in 'lib\ffmpeg\rational.pas',
+
+
+ // Sql Lite
+ SQLiteTable3 in 'lib\SQLite\SQLiteTable3.pas',
+ SQLite3 in 'lib\SQLite\SQLite3.pas',
+
+
+ //------------------------------
+ //Includes - Menu System
+ //------------------------------
+
+ UDisplay in 'Menu\UDisplay.pas',
+ UDrawTexture in 'Menu\UDrawTexture.pas',
+ UMenu in 'Menu\UMenu.pas',
+ UMenuButton in 'Menu\UMenuButton.pas',
+ UMenuButtonCollection in 'Menu\UMenuButtonCollection.pas',
+ UMenuInteract in 'Menu\UMenuInteract.pas',
+ UMenuSelect in 'Menu\UMenuSelect.pas',
+ UMenuSelectSlide in 'Menu\UMenuSelectSlide.pas',
+ UMenuStatic in 'Menu\UMenuStatic.pas',
+ UMenuText in 'Menu\UMenuText.pas',
+
+ //------------------------------
+ //Includes - Classes
+ //------------------------------
+
+ {$IFDEF FPC}
+ ulazjpeg in 'Classes\ulazjpeg.pas',
+ {$ENDIF}
+
+ TextGL in 'Classes\TextGL.pas',
+ UCatCovers in 'Classes\UCatCovers.pas',
+ UCommandLine in 'Classes\UCommandLine.pas',
+ UCommon in 'Classes\UCommon.pas',
+ UCovers in 'Classes\UCovers.pas',
+ UDataBase in 'Classes\UDataBase.pas',
+ UDLLManager in 'Classes\UDLLManager.pas',
+ UDraw in 'Classes\UDraw.pas',
+ UFiles in 'Classes\UFiles.pas',
+ UGraphic in 'Classes\UGraphic.pas',
+ UGraphicClasses in 'Classes\UGraphicClasses.pas',
+ UIni in 'Classes\UIni.pas',
+ UJoystick in 'Classes\UJoystick.pas',
+ ULanguage in 'Classes\ULanguage.pas',
+ ULCD in 'Classes\ULCD.pas',
+ ULight in 'Classes\ULight.pas',
+ ULog in 'Classes\ULog.pas',
+ ULyrics in 'Classes\ULyrics.pas',
+ ULyrics_bak in 'Classes\ULyrics_bak.pas',
+ UMain in 'Classes\UMain.pas',
+ UMusic in 'Classes\UMusic.pas',
+ UParty in 'Classes\UParty.pas',
+ UPlaylist in 'Classes\UPlaylist.pas',
+ URecord in 'Classes\URecord.pas',
+ USkins in 'Classes\USkins.pas',
+ USongs in 'Classes\USongs.pas',
+ UTexture in 'Classes\UTexture.pas',
+ UThemes in 'Classes\UThemes.pas',
+ UTime in 'Classes\UTime.pas',
+
+
+ //------------------------------
+ //Includes - Video Support
+ //------------------------------
+ UVideo in 'Classes\UVideo.pas',
+
+
+ //------------------------------
+ //Includes - Screens
+ //------------------------------
+ UScreenCredits in 'Screens\UScreenCredits.pas',
+ UScreenEdit in 'Screens\UScreenEdit.pas',
+ UScreenEditConvert in 'Screens\UScreenEditConvert.pas',
+ UScreenEditHeader in 'Screens\UScreenEditHeader.pas',
+ UScreenEditSub in 'Screens\UScreenEditSub.pas',
+ UScreenLevel in 'Screens\UScreenLevel.pas',
+ UScreenLoading in 'Screens\UScreenLoading.pas',
+ UScreenMain in 'Screens\UScreenMain.pas',
+ UScreenName in 'Screens\UScreenName.pas',
+ UScreenOpen in 'Screens\UScreenOpen.pas',
+ UScreenOptions in 'Screens\UScreenOptions.pas',
+ UScreenOptionsAdvanced in 'Screens\UScreenOptionsAdvanced.pas',
+ UScreenOptionsGame in 'Screens\UScreenOptionsGame.pas',
+ UScreenOptionsGraphics in 'Screens\UScreenOptionsGraphics.pas',
+ UScreenOptionsLyrics in 'Screens\UScreenOptionsLyrics.pas',
+ UScreenOptionsRecord in 'Screens\UScreenOptionsRecord.pas',
+ UScreenOptionsSound in 'Screens\UScreenOptionsSound.pas',
+ UScreenOptionsThemes in 'Screens\UScreenOptionsThemes.pas',
+ UScreenPopup in 'Screens\UScreenPopup.pas',
+ UScreenScore in 'Screens\UScreenScore.pas',
+ UScreenSing in 'Screens\UScreenSing.pas',
+ UScreenSong in 'Screens\UScreenSong.pas',
+ UScreenSongJumpto in 'Screens\UScreenSongJumpto.pas',
+ UScreenSongMenu in 'Screens\UScreenSongMenu.pas',
+ UScreenStatDetail in 'Screens\UScreenStatDetail.pas',
+ UScreenStatMain in 'Screens\UScreenStatMain.pas',
+ UScreenTop5 in 'Screens\UScreenTop5.pas',
+ UScreenWelcome in 'Screens\UScreenWelcome.pas',
+
+ //------------------------------
+ //Includes - Screens PartyMode
+ //------------------------------
+ UScreenPartyNewRound in 'Screens\UScreenPartyNewRound.pas',
+ UScreenPartyOptions in 'Screens\UScreenPartyOptions.pas',
+ UScreenPartyPlayer in 'Screens\UScreenPartyPlayer.pas',
+ UScreenPartyScore in 'Screens\UScreenPartyScore.pas',
+ UScreenPartyWin in 'Screens\UScreenPartyWin.pas',
+ UScreenSingModi in 'Screens\UScreenSingModi.pas',
+
+ //------------------------------
+ //Includes - Modi SDK
+ //------------------------------
+ ModiSDK in '..\..\Modis\SDK\ModiSDK.pas',
+
+
+ //------------------------------
+ //Includes - Delphi
+ //------------------------------
+ {$IFDEF win32}
+ Windows,
+ {$ENDIF}
+ SysUtils;
+
+const
+ Version = 'UltraStar Deluxe V 1.10 Alpha Build';
+
+var
+ WndTitle: string;
+ hWnd: THandle;
+ I: Integer;
+
+begin
+ WndTitle := Version;
+
+
+ {$ifdef Win32}
+ //------------------------------
+ //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. Contìnue ?'), 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);
+
+ // 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);
+
+ // Graphics
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize 3D', 'Initialization'); Initialize3D(WndTitle);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing 3D', 1);
+
+ // Sound
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Sound', 'Initialization');
+ Log.LogStatus('Creating Music', 'InitializeSound'); Music := TMusic.Create;
+ InitializeSound;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Sound', 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);
+
+
+ //------------------------------
+ //Start- Mainloop
+ //------------------------------
+ //Music.SetLoop(true);
+ //Music.SetVolume(50);
+ //Music.Open(SkinPath + 'Menu Music 3.mp3');
+ //Music.Play;
+ Log.LogStatus('Main Loop', 'Initialization'); MainLoop;
+
+ Log.LogStatus('Cleanup', 'Done');
+
+ //------------------------------
+ //Finish Application
+ //------------------------------
+ if Ini.LPT = 1 then LCD.Clear;
+ if Ini.LPT = 2 then Light.TurnOff;
+
+ Log.Free;
+end.
|