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