From c316180c74e144a5faecfe30ab38c8e4e0ef9e91 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 7 Apr 2008 08:50:43 +0000 Subject: - Removed lrs resource usage in linux. Resources are copied to /usr/share/resources now. - Unified resource handling: call GetResourceStream (UCommon) to retrieve a resource. - Removed the lazarus dependency in the Makefile (it will also use the main .dpr-file now) - Now that the lazarus dependency is gone, the MacOSX and Linux version might use a shared codebase. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1013 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 1071 ++++++++++++++++++++-------------------- Game/Code/Classes/UCommon.pas | 653 +++++++++++++----------- Game/Code/Classes/UMain.pas | 365 +++++++------- Game/Code/Classes/UTexture.pas | 161 ++---- Game/Code/Makefile.in | 51 +- Game/Code/USDXResCompiler.exe | Bin 1698394 -> 0 bytes Game/Code/configure.ac | 116 ++--- 7 files changed, 1189 insertions(+), 1228 deletions(-) delete mode 100644 Game/Code/USDXResCompiler.exe (limited to 'Game') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index c4399a7a..f078169f 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,546 +1,525 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - OpenGL12, - SDL, - UTexture, - Classes, - SDL_ttf, - ULog; - -procedure BuildFont; // Build Our Bitmap Font -procedure KillFont; // Delete The Font -function glTextWidth(text: pchar): real; // Returns Text Width -procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); -procedure glPrintLetter(letter: char); -procedure glPrintLetterCut(letter: char; Start, Finish: real); -procedure glPrint(text: pchar); // Custom GL "Print" Routine -procedure glPrintCut(text: pchar); -procedure SetFontPos(X, Y: real); // Sets X And Y -procedure SetFontSize(Size: real); -procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) -procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) -procedure SetFontAspectW(Aspect: real); - -// Start of SDL_ttf -function NextPowerOfTwo(Value: Integer): Integer; -//Checks if the ttf exists, if yes then a SDL_ttf is returned -function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; - -// Does the renderstuff, color is in $ffeecc style -function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; -procedure printrandomtext(); -// End of SDL_ttf - -type - TTextGL = record - X: real; - Y: real; - Text: string; - Size: real; - ColR: real; - ColG: real; - ColB: real; - end; - - TFont = record - Tex: TTexture; - Width: array[0..255] of byte; - AspectW: real; - Centered: boolean; - Done: real; - Outline: real; - Italic: boolean; - end; - - -var - base: GLuint; // Base Display List For The Font Set - Fonts: array of TFont; - ActFont: integer; - PColR: real; // temps for glPrintDone - PColG: real; - PColB: real; - -implementation - -uses - UMain, - UCommon, - SysUtils, - {$IFDEF LCL} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - UGraphic; - -procedure BuildFont; // Build Our Bitmap Font - - procedure loadfont( aID : integer; aType, aResourceName : String); - {$IFDEF LCL} - 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 - Reg: TResourceStream; - begin - try - Reg := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) ); - try - Reg.Read(Fonts[ aID ].Width, 256); - finally - Reg.Free; - end; - {$ENDIF} - - except - Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR'); - end; - end; - -var - Count: integer; -begin - ActFont := 0; - - //Log.LogStatus( '' , '---------------------------'); - - //Log.LogStatus( 'Font' , '---------------------------'); - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[0].Tex.H := 30; - Fonts[0].AspectW := 0.9; - Fonts[0].Done := -1; - Fonts[0].Outline := 0; - - //Log.LogStatus( 'FontB' , '---------------------------'); - - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Done := -1; - Fonts[1].Outline := 0; - - //Log.LogStatus( 'FontO' , '---------------------------'); - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Done := -1; - Fonts[2].Outline := 5; - - //Log.LogStatus( 'FontO2' , '---------------------------'); - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[3].Tex.H := 30; - Fonts[3].AspectW := 0.95; - Fonts[3].Done := -1; - Fonts[3].Outline := 4; - -{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - - - loadfont( 0, 'FNT', 'Font' ); - loadfont( 1, 'FNT', 'FontB' ); - loadfont( 2, 'FNT', 'FontO' ); - loadfont( 3, 'FNT', 'FontO2' ); - -{ Reg := TResourceStream.Create(HInstance, 'FontO', 'FNT'); - Reg.Read(Fonts[4].Width, 256); - Reg.Free;} - - for Count := 0 to 255 do - Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; - - for Count := 0 to 255 do - Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; - - for Count := 0 to 255 do - Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; - -{ for Count := 0 to 255 do - Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} - -end; - -procedure KillFont; // Delete The Font -begin -// glDeleteLists(base, 256); // Delete All 96 Characters -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; - i: integer; -begin -// Log.LogStatus(Text, 'glTextWidth'); - Result := 0; - for i := 0 to Length(text) -1 do // Patched by AlexanderS : bug with wrong sliced text lines - begin - Letter := Text[i]; - // Bugfix: does not work with FPC, probably because a part of text is assigned to itself - //text := pchar(Copy(text, 2, Length(text)-1)); - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; -end; - -procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); -begin - Fonts[ActFont].Done := Done; - PColR := ColR; - PColG := ColG; - PColB := ColB; - glPrintCut(text); - Fonts[ActFont].Done := -1; -end; - -procedure glPrintLetter(Letter: char); -var - TexX, TexY: real; - TexR, TexB: real; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter -begin - with Fonts[ActFont].Tex do - begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; - // H := 30; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - // set vector positions - PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2; - PT := Y; - PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; - PB := PT + H; - - if Fonts[ActFont].Italic = false then - XItal := 0 - else - XItal := 12; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, TexNum); - - glBegin(GL_QUADS); - try - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); - finally - glEnd; - end; - - X := X + W; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with -end; - -procedure glPrintLetterCut(letter: char; Start, Finish: real); -var - TexX, TexY: real; - TexR, TexB: real; - TexTemp: real; - FWidth: real; - PL, PT: real; - PR, PB: real; - OutTemp: real; - XItal: real; -begin - with Fonts[ActFont].Tex do begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; -// H := 30; - OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - TexTemp := TexX + Start * (TexR - TexX); - TexR := TexX + Finish * (TexR - TexX); - TexX := TexTemp; - - // set vector positions - PL := X - OutTemp / 2 + OutTemp * Start; - PT := Y; - PR := PL + (W + OutTemp) * (Finish - Start); - PB := PT + H; - if Fonts[ActFont].Italic = false then - XItal := 0 - else - XItal := 12; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, TexNum); - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); // not tested with XItal - glEnd; - X := X + W * (Finish - Start); - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with - -end; - -procedure glPrint(text: pchar); // Custom GL "Print" Routine -var -// Letter : char; - iPos : Integer; - -begin - if (Text = '') then // If There's No Text - Exit; // Do Nothing - -(* - while (length(text) > 0) do - begin - // cut - Letter := Text[0]; - Text := pchar(Copy(Text, 2, Length(Text)-1)); - - // print - glPrintLetter(Letter); - end; // while -*) - - // This code is better, because doing a Copy of for every - // letter in a string is a waste of CPU & Memory resources. - // Copy operations are quite memory intensive, and this simple - // code achieves the same result. - for iPos := 0 to length( text ) - 1 do - begin - glPrintLetter( Text[iPos] ); - end; - -end; - -function NextPowerOfTwo(Value: Integer): Integer; -// tyty to Asphyre -begin - Result:= 1; - asm - xor ecx, ecx - bsr ecx, Value - inc ecx - shl Result, cl - end; -end; - -function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; -begin - if (FileExists(FileName)) then - begin - Result := TTF_OpenFont( FileName, PointSize ); - end - else - begin - Log.LogStatus('ERROR Could not find font in ' + FileName , ''); - ShowMessage( 'ERROR Could not find font in ' + FileName ); - Result := nil; - end; -end; - -function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; -var - clr : TSDL_color; -begin - clr.r := ((Color and $ff0000) shr 16 ) div 255; - clr.g := ((Color and $ff00 ) shr 8 ) div 255; - clr.b := ( Color and $ff ) div 255 ; - - result := TTF_RenderText_Blended( font, text, cLr); -end; - -procedure printrandomtext(); -var - stext,intermediary : PSDL_surface; - clrFg, clrBG : TSDL_color; - texture : Gluint; - font : PTTF_Font; - w,h : integer; -begin - -font := LoadFont('fonts\comicbd.ttf', 42); - -clrFg.r := 255; -clrFg.g := 255; -clrFg.b := 255; -clrFg.unused := 255; - -clrBg.r := 255; -clrbg.g := 0; -clrbg.b := 255; -clrbg.unused := 0; - - sText := RenderText(font, 'katzeeeeeee', $fe198e); -//sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); - - // Convert the rendered text to a known format - w := nextpoweroftwo(sText.w); - h := nextpoweroftwo(sText.h); - -intermediary := SDL_CreateRGBSurface(0, w, h, 32, - $000000ff, $0000ff00, $00ff0000, $ff000000); - - SDL_SetAlpha(intermediary, 0, 255); - SDL_SetAlpha(sText, 0, 255); - SDL_BlitSurface(sText, nil, intermediary, nil); - - glGenTextures(1, @texture); - - glBindTexture(GL_TEXTURE_2D, texture); - - glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - - - - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_BLEND); - glBindTexture(GL_TEXTURE_2D, texture); - glColor4f(1, 0, 1, 1); - - glbegin(gl_quads); - glTexCoord2f(0,0); glVertex2f(200, 300); - glTexCoord2f(0,sText.h/h); glVertex2f(200 , 300 + sText.h); - glTexCoord2f(sText.w/w,sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); - glTexCoord2f(sText.w/w,0); glVertex2f(200 + sText.w, 300); - glEnd; - glfinish(); - glDisable(GL_BLEND); - gldisable(gl_texture_2d); - - - - -SDL_FreeSurface( sText ); -SDL_FreeSurface( intermediary ); -glDeleteTextures(1, @texture); -TTF_CloseFont( font ); - -end; - -procedure glPrintCut(text: pchar); -var - Letter: char; - PToDo: real; - PTotWidth: real; - PDoingNow: real; - S: string; -begin - if (Text = '') then // If There's No Text - Exit; // Do Nothing - - PTotWidth := glTextWidth(Text); - PToDo := Fonts[ActFont].Done; - - while (length(text) > 0) do begin - // cut - Letter := Text[0]; - Text := pchar(Copy(Text, 2, Length(Text)-1)); - - // analyze - S := Letter; - PDoingNow := glTextWidth(pchar(S)) / PTotWidth; - - // drawing - if (PToDo > 0) and (PDoingNow <= PToDo) then - glPrintLetter(Letter); - - if (PToDo > 0) and (PDoingNow > PToDo) then begin - glPrintLetterCut(Letter, 0, PToDo / PDoingNow); - glColor3f(PColR, PColG, PColB); - glPrintLetterCut(Letter, PToDo / PDoingNow, 1); - end; - - if (PToDo <= 0) then - glPrintLetter(Letter); - - PToDo := PToDo - PDoingNow; - - end; // while -end; - - -procedure SetFontPos(X, Y: real); -begin - Fonts[ActFont].Tex.X := X; - Fonts[ActFont].Tex.Y := Y; -end; - -procedure SetFontSize(Size: real); -begin - Fonts[ActFont].Tex.H := 30 * (Size/10); -end; - -procedure SetFontStyle(Style: integer); -begin - ActFont := Style; -end; - -procedure SetFontItalic(Enable: boolean); -begin - Fonts[ActFont].Italic := Enable; -end; - -procedure SetFontAspectW(Aspect: real); -begin - Fonts[ActFont].AspectW := Aspect; -end; - -end. - - +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + OpenGL12, + SDL, + UTexture, + Classes, + SDL_ttf, + ULog; + +procedure BuildFont; // Build Our Bitmap Font +procedure KillFont; // Delete The Font +function glTextWidth(text: pchar): real; // Returns Text Width +procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); +procedure glPrintLetter(letter: char); +procedure glPrintLetterCut(letter: char; Start, Finish: real); +procedure glPrint(text: pchar); // Custom GL "Print" Routine +procedure glPrintCut(text: pchar); +procedure SetFontPos(X, Y: real); // Sets X And Y +procedure SetFontSize(Size: real); +procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) +procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) +procedure SetFontAspectW(Aspect: real); + +// Start of SDL_ttf +function NextPowerOfTwo(Value: Integer): Integer; +//Checks if the ttf exists, if yes then a SDL_ttf is returned +function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; + +// Does the renderstuff, color is in $ffeecc style +function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; +procedure printrandomtext(); +// End of SDL_ttf + +type + TTextGL = record + X: real; + Y: real; + Text: string; + Size: real; + ColR: real; + ColG: real; + ColB: real; + end; + + TFont = record + Tex: TTexture; + Width: array[0..255] of byte; + AspectW: real; + Centered: boolean; + Done: real; + Outline: real; + Italic: boolean; + end; + + +var + base: GLuint; // Base Display List For The Font Set + Fonts: array of TFont; + ActFont: integer; + PColR: real; // temps for glPrintDone + PColG: real; + PColB: real; + +implementation + +uses + UMain, + UCommon, + SysUtils, + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + UGraphic; + +procedure BuildFont; // Build Our Bitmap Font + + procedure loadfont(aID : integer; const aType, aResourceName: string); + var + stream: TStream; + begin + stream := GetResourceStream(aResourceName, aType); + if (not assigned(stream)) then + begin + Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + Exit; + end; + try + stream.Read(Fonts[ aID ].Width, 256); + except + Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + end; + stream.Free; + end; + +var + Count: integer; +begin + ActFont := 0; + + //Log.LogStatus( '' , '---------------------------'); + + //Log.LogStatus( 'Font' , '---------------------------'); + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Done := -1; + Fonts[0].Outline := 0; + + //Log.LogStatus( 'FontB' , '---------------------------'); + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Done := -1; + Fonts[1].Outline := 0; + + //Log.LogStatus( 'FontO' , '---------------------------'); + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Done := -1; + Fonts[2].Outline := 5; + + //Log.LogStatus( 'FontO2' , '---------------------------'); + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[3].Tex.H := 30; + Fonts[3].AspectW := 0.95; + Fonts[3].Done := -1; + Fonts[3].Outline := 4; + +{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + + + loadfont( 0, 'FNT', 'Font' ); + loadfont( 1, 'FNT', 'FontB' ); + loadfont( 2, 'FNT', 'FontO' ); + loadfont( 3, 'FNT', 'FontO2' ); + +{ Reg := TResourceStream.Create(HInstance, 'FontO', 'FNT'); + Reg.Read(Fonts[4].Width, 256); + Reg.Free;} + + for Count := 0 to 255 do + Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; + + for Count := 0 to 255 do + Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; + + for Count := 0 to 255 do + Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; + +{ for Count := 0 to 255 do + Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} + +end; + +procedure KillFont; // Delete The Font +begin +// glDeleteLists(base, 256); // Delete All 96 Characters +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; + i: integer; +begin +// Log.LogStatus(Text, 'glTextWidth'); + Result := 0; + for i := 0 to Length(text) -1 do // Patched by AlexanderS : bug with wrong sliced text lines + begin + Letter := Text[i]; + // Bugfix: does not work with FPC, probably because a part of text is assigned to itself + //text := pchar(Copy(text, 2, Length(text)-1)); + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; +end; + +procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); +begin + Fonts[ActFont].Done := Done; + PColR := ColR; + PColG := ColG; + PColB := ColB; + glPrintCut(text); + Fonts[ActFont].Done := -1; +end; + +procedure glPrintLetter(Letter: char); +var + TexX, TexY: real; + TexR, TexB: real; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter +begin + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + // H := 30; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + // set vector positions + PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2; + PT := Y; + PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; + PB := PT + H; + + if Fonts[ActFont].Italic = false then + XItal := 0 + else + XItal := 12; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, TexNum); + + glBegin(GL_QUADS); + try + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + finally + glEnd; + end; + + X := X + W; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with +end; + +procedure glPrintLetterCut(letter: char; Start, Finish: real); +var + TexX, TexY: real; + TexR, TexB: real; + TexTemp: real; + FWidth: real; + PL, PT: real; + PR, PB: real; + OutTemp: real; + XItal: real; +begin + with Fonts[ActFont].Tex do begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; +// H := 30; + OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + TexTemp := TexX + Start * (TexR - TexX); + TexR := TexX + Finish * (TexR - TexX); + TexX := TexTemp; + + // set vector positions + PL := X - OutTemp / 2 + OutTemp * Start; + PT := Y; + PR := PL + (W + OutTemp) * (Finish - Start); + PB := PT + H; + if Fonts[ActFont].Italic = false then + XItal := 0 + else + XItal := 12; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, TexNum); + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); // not tested with XItal + glEnd; + X := X + W * (Finish - Start); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with + +end; + +procedure glPrint(text: pchar); // Custom GL "Print" Routine +var +// Letter : char; + iPos : Integer; + +begin + if (Text = '') then // If There's No Text + Exit; // Do Nothing + +(* + while (length(text) > 0) do + begin + // cut + Letter := Text[0]; + Text := pchar(Copy(Text, 2, Length(Text)-1)); + + // print + glPrintLetter(Letter); + end; // while +*) + + // This code is better, because doing a Copy of for every + // letter in a string is a waste of CPU & Memory resources. + // Copy operations are quite memory intensive, and this simple + // code achieves the same result. + for iPos := 0 to length( text ) - 1 do + begin + glPrintLetter( Text[iPos] ); + end; + +end; + +function NextPowerOfTwo(Value: Integer): Integer; +// tyty to Asphyre +begin + Result:= 1; + asm + xor ecx, ecx + bsr ecx, Value + inc ecx + shl Result, cl + end; +end; + +function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; +begin + if (FileExists(FileName)) then + begin + Result := TTF_OpenFont( FileName, PointSize ); + end + else + begin + Log.LogStatus('ERROR Could not find font in ' + FileName , ''); + ShowMessage( 'ERROR Could not find font in ' + FileName ); + Result := nil; + end; +end; + +function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; +var + clr : TSDL_color; +begin + clr.r := ((Color and $ff0000) shr 16 ) div 255; + clr.g := ((Color and $ff00 ) shr 8 ) div 255; + clr.b := ( Color and $ff ) div 255 ; + + result := TTF_RenderText_Blended( font, text, cLr); +end; + +procedure printrandomtext(); +var + stext,intermediary : PSDL_surface; + clrFg, clrBG : TSDL_color; + texture : Gluint; + font : PTTF_Font; + w,h : integer; +begin + +font := LoadFont('fonts\comicbd.ttf', 42); + +clrFg.r := 255; +clrFg.g := 255; +clrFg.b := 255; +clrFg.unused := 255; + +clrBg.r := 255; +clrbg.g := 0; +clrbg.b := 255; +clrbg.unused := 0; + + sText := RenderText(font, 'katzeeeeeee', $fe198e); +//sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); + + // Convert the rendered text to a known format + w := nextpoweroftwo(sText.w); + h := nextpoweroftwo(sText.h); + +intermediary := SDL_CreateRGBSurface(0, w, h, 32, + $000000ff, $0000ff00, $00ff0000, $ff000000); + + SDL_SetAlpha(intermediary, 0, 255); + SDL_SetAlpha(sText, 0, 255); + SDL_BlitSurface(sText, nil, intermediary, nil); + + glGenTextures(1, @texture); + + glBindTexture(GL_TEXTURE_2D, texture); + + glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + + + + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glBindTexture(GL_TEXTURE_2D, texture); + glColor4f(1, 0, 1, 1); + + glbegin(gl_quads); + glTexCoord2f(0,0); glVertex2f(200, 300); + glTexCoord2f(0,sText.h/h); glVertex2f(200 , 300 + sText.h); + glTexCoord2f(sText.w/w,sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); + glTexCoord2f(sText.w/w,0); glVertex2f(200 + sText.w, 300); + glEnd; + glfinish(); + glDisable(GL_BLEND); + gldisable(gl_texture_2d); + + + + +SDL_FreeSurface( sText ); +SDL_FreeSurface( intermediary ); +glDeleteTextures(1, @texture); +TTF_CloseFont( font ); + +end; + +procedure glPrintCut(text: pchar); +var + Letter: char; + PToDo: real; + PTotWidth: real; + PDoingNow: real; + S: string; +begin + if (Text = '') then // If There's No Text + Exit; // Do Nothing + + PTotWidth := glTextWidth(Text); + PToDo := Fonts[ActFont].Done; + + while (length(text) > 0) do begin + // cut + Letter := Text[0]; + Text := pchar(Copy(Text, 2, Length(Text)-1)); + + // analyze + S := Letter; + PDoingNow := glTextWidth(pchar(S)) / PTotWidth; + + // drawing + if (PToDo > 0) and (PDoingNow <= PToDo) then + glPrintLetter(Letter); + + if (PToDo > 0) and (PDoingNow > PToDo) then begin + glPrintLetterCut(Letter, 0, PToDo / PDoingNow); + glColor3f(PColR, PColG, PColB); + glPrintLetterCut(Letter, PToDo / PDoingNow, 1); + end; + + if (PToDo <= 0) then + glPrintLetter(Letter); + + PToDo := PToDo - PDoingNow; + + end; // while +end; + + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].Tex.X := X; + Fonts[ActFont].Tex.Y := Y; +end; + +procedure SetFontSize(Size: real); +begin + Fonts[ActFont].Tex.H := 30 * (Size/10); +end; + +procedure SetFontStyle(Style: integer); +begin + ActFont := Style; +end; + +procedure SetFontItalic(Enable: boolean); +begin + Fonts[ActFont].Italic := Enable; +end; + +procedure SetFontAspectW(Aspect: real); +begin + Fonts[ActFont].AspectW := Aspect; +end; + +end. + + diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index dce11ea0..5582c59b 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,300 +1,353 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - Messages, -{$IFDEF LCL} - lResources, -{$ENDIF} -{$IFDEF win32} - Windows, -{$ENDIF} - ULog; - -{$IFNDEF DARWIN} -// FIXME: remove this if it is not needed anymore -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF LCL} - function LazFindResource( const aName, aType : String ): TLResource; -{$ENDIF} - -procedure ShowMessage( const msg : String ); - -{$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -{$ENDIF} - -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(hWnd: HWND); -{$IFEND} - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - - -{$IFNDEF win32} - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -(* - * Character classes - *) - -function IsAlphaChar(ch: WideChar): boolean; -function IsNumericChar(ch: WideChar): boolean; -function IsAlphaNumericChar(ch: WideChar): boolean; -function IsPunctuationChar(ch: WideChar): boolean; -function IsControlChar(ch: WideChar): boolean; - - -implementation - -uses -{$IFDEF Delphi} - Dialogs, -{$ENDIF} - UConfig; - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -var - iPos : integer; -// sTemp : WideString; -begin -(* - result := text; - iPos := Pos(search, result); - while (iPos > 0) do - begin - sTemp := copy(result, iPos + length(search), length(result)); - result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); - end; -*) - result := text; - - if search = rep then - exit; - - for iPos := 0 to length( result ) - 1 do - begin - if result[ iPos ] = search then - result[ iPos ] := rep; - end; -end; - -function AdaptFilePaths( const aPath : widestring ): widestring; -begin - result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); -end; - - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime here maybe ... from libc - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - - -{$IFDEF LCL} -function LazFindResource( const aName, aType : String ): TLResource; -var - iCount : Integer; -begin - result := nil; - - for iCount := 0 to LazarusResources.count -1 do - begin - if ( LazarusResources.items[ iCount ].Name = aName ) AND - ( LazarusResources.items[ iCount ].ValueType = aType ) THEN - begin - result := LazarusResources.items[ iCount ]; - exit; - end; - end; -end; -{$ENDIF} - -{$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin - RandomRange := Random(aMax-aMin) + aMin ; -end; -{$ENDIF} - -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -var - Msg: TMessage; - MethodPtr: ^TWndMethod; -begin - FillChar(Msg, SizeOf(Msg), 0); - Msg.msg := uMsg; - Msg.wParam := wParam; - Msg.lParam := lParam; - - MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); - if Assigned(MethodPtr) then - MethodPtr^(Msg); - - Result := DefWindowProc(hwnd, uMsg, wParam, lParam); -end; - -function AllocateHWnd(Method: TWndMethod): HWND; -var - ClassExists: Boolean; - WndClass, OldClass: TWndClass; - MethodPtr: ^TMethod; -begin - Result := 0; - - // setup class-info - FillChar(WndClass, SizeOf(TWndClass), 0); - WndClass.hInstance := HInstance; - // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, - // otherwise race-conditions might occur - WndClass.lpfnWndProc := @DefWindowProc; - WndClass.lpszClassName:= 'USDXUtilWindowClass'; - - // check if class is already registered - ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); - // create window-class shared by all windows created by AllocateHWnd() - if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then - begin - if ClassExists then - UnregisterClass(WndClass.lpszClassName, HInstance); - if (RegisterClass(WndClass) = 0) then - Exit; - end; - // create window - Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', - WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil); - if (Result = 0) then - Exit; - // assign individual callback procedure to the window - if Assigned(Method) then - begin - // TMethod contains two pointers but we can pass just one as USERDATA - GetMem(MethodPtr, SizeOf(TMethod)); - MethodPtr^ := TMethod(Method); - SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); - end; - // now enable AllocateHWndCallback for this window - SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); -end; - -procedure DeallocateHWnd(hWnd: HWND); -var - MethodPtr: ^TMethod; -begin - if (hWnd <> 0) then - begin - MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); - DestroyWindow(hWnd); - if Assigned(MethodPtr) then - FreeMem(MethodPtr); - end; -end; -{$IFEND} - -procedure ShowMessage( const msg : String ); -begin -{$IF Defined(MSWINDOWS)} - MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION); -{$ELSE} - debugwriteln(msg); -{$IFEND} -end; - -function IsAlphaChar(ch: WideChar): boolean; -begin - // TODO: add chars > 255 when unicode-fonts work? - case ch of - 'A'..'Z', // A-Z - 'a'..'z', // a-z - #170,#181,#186, - #192..#214, - #216..#246, - #248..#255: - Result := true; - else - Result := false; - end; -end; - -function IsNumericChar(ch: WideChar): boolean; -begin - case ch of - '0'..'9': - Result := true; - else - Result := false; - end; -end; - -function IsAlphaNumericChar(ch: WideChar): boolean; -begin - Result := (IsAlphaChar(ch) or IsNumericChar(ch)); -end; - -function IsPunctuationChar(ch: WideChar): boolean; -begin - // TODO: add chars outside of Latin1 basic (0..127)? - case ch of - ' '..'/',':'..'@','['..'`','{'..'~': - Result := true; - else - Result := false; - end; -end; - -function IsControlChar(ch: WideChar): boolean; -begin - case ch of - #0..#31, - #127..#159: - Result := true; - else - Result := false; - end; -end; - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, +{$IFDEF MSWINDOWS} + Windows, + Messages, +{$ENDIF} + ULog; + +{$IFNDEF DARWIN} +// FIXME: remove this if it is not needed anymore +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +function GetResourceStream(const aName, aType : string): TStream; + +procedure ShowMessage( const msg : String ); + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +{$ENDIF} + +{$IF Defined(MSWINDOWS) and Defined(FPC)} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(hWnd: HWND); +{$IFEND} + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + + +{$IFNDEF win32} + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +function FileExistsInsensitive(var FileName: string): boolean; + +(* + * Character classes + *) + +function IsAlphaChar(ch: WideChar): boolean; +function IsNumericChar(ch: WideChar): boolean; +function IsAlphaNumericChar(ch: WideChar): boolean; +function IsPunctuationChar(ch: WideChar): boolean; +function IsControlChar(ch: WideChar): boolean; + + +implementation + +uses +{$IFDEF Delphi} + Dialogs, +{$ENDIF} + UMain, + UConfig; + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 0 to length( result ) - 1 do + begin + if result[ iPos ] = search then + result[ iPos ] := rep; + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + +// Checks if a regular files or directory with the given name exists. +// The comparison is case insensitive. +function FileExistsInsensitive(var FileName: string): boolean; +var + FilePath, LocalFileName: string; + SearchInfo: TSearchRec; +begin +{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems + // speed up standard case + if FileExists(FileName) then + begin + Result := true; + exit; + end; + + Result := false; + + FilePath := ExtractFilePath(FileName); + if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then + begin + LocalFileName := ExtractFileName(FileName); + repeat + if (AnsiSameText(LocalFileName, SearchInfo.Name)) then + begin + FileName := FilePath + SearchInfo.Name; + Result := true; + break; + end; + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); +{$ELSE} + Result := FileExists(FileName); +{$ENDIF} +end; + + +{$IFDEF Linux} + // include resource-file info (stored in the constant array "resources") + {$I ../resource.inc} +{$ENDIF} + +function GetResourceStream(const aName, aType: string): TStream; +{$IFDEF Linux} +var + ResIndex: integer; + Filename: string; +{$ENDIF} +begin + Result := nil; + + {$IFDEF Linux} + for ResIndex := 0 to High(resources) do + begin + if (resources[ResIndex][0] = aName ) and + (resources[ResIndex][1] = aType ) then + begin + try + Filename := ResourcesPath + resources[ResIndex][2]; + Result := TFileStream.Create(Filename, fmOpenRead); + except + Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream'); + end; + exit; + end; + end; + {$ELSE} + try + Result := TResourceStream.Create(HInstance, aName , PChar(aType)); + except + Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream'); + end; + {$ENDIF} +end; + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin + RandomRange := Random(aMax-aMin) + aMin ; +end; +{$ENDIF} + +{$IF Defined(MSWINDOWS) and Defined(FPC)} +function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +var + Msg: TMessage; + MethodPtr: ^TWndMethod; +begin + FillChar(Msg, SizeOf(Msg), 0); + Msg.msg := uMsg; + Msg.wParam := wParam; + Msg.lParam := lParam; + + MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); + if Assigned(MethodPtr) then + MethodPtr^(Msg); + + Result := DefWindowProc(hwnd, uMsg, wParam, lParam); +end; + +function AllocateHWnd(Method: TWndMethod): HWND; +var + ClassExists: Boolean; + WndClass, OldClass: TWndClass; + MethodPtr: ^TMethod; +begin + Result := 0; + + // setup class-info + FillChar(WndClass, SizeOf(TWndClass), 0); + WndClass.hInstance := HInstance; + // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, + // otherwise race-conditions might occur + WndClass.lpfnWndProc := @DefWindowProc; + WndClass.lpszClassName:= 'USDXUtilWindowClass'; + + // check if class is already registered + ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); + // create window-class shared by all windows created by AllocateHWnd() + if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then + begin + if ClassExists then + UnregisterClass(WndClass.lpszClassName, HInstance); + if (RegisterClass(WndClass) = 0) then + Exit; + end; + // create window + Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', + WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result = 0) then + Exit; + // assign individual callback procedure to the window + if Assigned(Method) then + begin + // TMethod contains two pointers but we can pass just one as USERDATA + GetMem(MethodPtr, SizeOf(TMethod)); + MethodPtr^ := TMethod(Method); + SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); + end; + // now enable AllocateHWndCallback for this window + SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); +end; + +procedure DeallocateHWnd(hWnd: HWND); +var + MethodPtr: ^TMethod; +begin + if (hWnd <> 0) then + begin + MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); + DestroyWindow(hWnd); + if Assigned(MethodPtr) then + FreeMem(MethodPtr); + end; +end; +{$IFEND} + +procedure ShowMessage( const msg : String ); +begin +{$IF Defined(MSWINDOWS)} + MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION); +{$ELSE} + debugwriteln(msg); +{$IFEND} +end; + +function IsAlphaChar(ch: WideChar): boolean; +begin + // TODO: add chars > 255 when unicode-fonts work? + case ch of + 'A'..'Z', // A-Z + 'a'..'z', // a-z + #170,#181,#186, + #192..#214, + #216..#246, + #248..#255: + Result := true; + else + Result := false; + end; +end; + +function IsNumericChar(ch: WideChar): boolean; +begin + case ch of + '0'..'9': + Result := true; + else + Result := false; + end; +end; + +function IsAlphaNumericChar(ch: WideChar): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsPunctuationChar(ch: WideChar): boolean; +begin + // TODO: add chars outside of Latin1 basic (0..127)? + case ch of + ' '..'/',':'..'@','['..'`','{'..'~': + Result := true; + else + Result := false; + end; +end; + +function IsControlChar(ch: WideChar): boolean; +begin + case ch of + #0..#31, + #127..#159: + Result := true; + else + Result := false; + end; +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 2c6c2fe5..b6a4fe02 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -78,6 +78,7 @@ var LanguagesPath: string; PluginPath: string; VisualsPath: string; + ResourcesPath: string; PlayListPath: string; UserSongPath: string = ''; @@ -863,187 +864,187 @@ begin end; procedure NewNote(Sender: TScreenSing); -var - CP: integer; // current player - S: integer; // sentence - SMin: integer; - SMax: integer; - SDet: integer; // temporary: sentence of detected note - Count: integer; - Mozna: boolean; - New: boolean; - Range: integer; - NoteHit:boolean; - MaxPoints: integer; // maximal points without line bonus -begin - // Log.LogStatus('Beat ' + IntToStr(LineState.CurrentBeat) + ' HalfBeat ' + IntToStr(LineState.AktHalf), 'NewBeat'); - - // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas - if not assigned( AudioInputProcessor.Sound ) then - exit; - - // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) - // albo juz lepiej nie - for CP := 0 to PlayersPlay-1 do - begin - // analyze buffer - AudioInputProcessor.Sound[CP].AnalyzeBuffer; - - // adds some noise - //LineState.Tone := LineState.Tone + Round(Random(3)) - 1; - - // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SMin := Lines[0].Current-1; - if SMin < 0 then - SMin := 0; - SMax := Lines[0].Current; - - // check if we can add new note - Mozna := false; - SDet:=SMin; - for S := SMin to SMax do - begin - for Count := 0 to Lines[0].Line[S].HighNote do - begin - if ((Lines[0].Line[S].Note[Count].Start <= LineState.CurrentBeatD) - and (Lines[0].Line[S].Note[Count].Start + Lines[0].Line[S].Note[Count].Length - 1 >= LineState.CurrentBeatD)) - and (Lines[0].Line[S].Note[Count].NoteType <> ntFreestyle) // but don't allow when it's FreeStyle note - and (Lines[0].Line[S].Note[Count].Length > 0) then // and make sure the note lengths is at least 1 - begin - SDet := S; - Mozna := true; - Break; - end; - end; - end; - - S := SDet; - - //Czas.SzczytJest := true; - //Czas.Tone := 27; - - // gdy moze, to dodaje nute - When Mozna, it adds note (?) - if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then - begin - // operowanie na ostatniej nucie - for Count := 0 to Lines[0].Line[S].HighNote do - begin - if (Lines[0].Line[S].Note[Count].Start <= LineState.OldBeatD+1) and - (Lines[0].Line[S].Note[Count].Start + - Lines[0].Line[S].Note[Count].Length > LineState.OldBeatD+1) then - begin - // to robi, tylko dla pary nut (oryginalnej i gracza) - - // przesuwanie tonu w odpowiednia game - while (AudioInputProcessor.Sound[CP].Tone - Lines[0].Line[S].Note[Count].Tone > 6) do - AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12; - - while (AudioInputProcessor.Sound[CP].Tone - Lines[0].Line[S].Note[Count].Tone < -6) do - AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone + 12; - - // Half size Notes Patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - if abs(Lines[0].Line[S].Note[Count].Tone - AudioInputProcessor.Sound[CP].Tone) <= Range then - begin - AudioInputProcessor.Sound[CP].Tone := Lines[0].Line[S].Note[Count].Tone; - - // Half size Notes Patch - NoteHit := true; - - MaxPoints := 10000; - if (Ini.LineBonus <> 0) then - MaxPoints := 9000; - - case Lines[0].Line[S].Note[Count].NoteType of - ntNormal: Player[CP].Score := Player[CP].Score + MaxPoints / Lines[0].ScoreValue * - Lines[0].Line[S].Note[Count].Length; - ntGolden: Player[CP].ScoreGolden := Player[CP].ScoreGolden + MaxPoints / Lines[0].ScoreValue * - (Lines[0].Line[S].Note[Count].Length * 2); - end; - - Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; - Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; - - Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; - end; - - end; // operowanie - end; // for - - // sprawdzanie czy to nowa nuta, czy przedluzenie - if S = SMax then - begin - New := true; - // if last has the same tone - if (Player[CP].IlNut > 0 ) and - (Player[CP].Note[Player[CP].HighNote].Tone = AudioInputProcessor.Sound[CP].Tone) and - (Player[CP].Note[Player[CP].HighNote].Start + Player[CP].Note[Player[CP].HighNote].Length = LineState.CurrentBeatD) then - begin - New := false; - end; - - // if is not as new note to control "beacie" (TODO: translate polish "beacie") - for Count := 0 to Lines[0].Line[S].HighNote do - begin - if (Lines[0].Line[S].Note[Count].Start = LineState.CurrentBeatD) then - New := true; - end; - - // dodawanie nowej nuty - if New then - begin - // New Note - Player[CP].IlNut := Player[CP].IlNut + 1; - Player[CP].HighNote := Player[CP].HighNote + 1; - SetLength(Player[CP].Note, Player[CP].IlNut); - Player[CP].Note[Player[CP].HighNote].Start := LineState.CurrentBeatD; - Player[CP].Note[Player[CP].HighNote].Length := 1; - Player[CP].Note[Player[CP].HighNote].Tone := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl - Player[CP].Note[Player[CP].HighNote].Detekt := LineState.MidBeat; - - // Half Note Patch - Player[CP].Note[Player[CP].HighNote].Hit := NoteHit; - - //Log.LogStatus('New Note ' + IntToStr(Gracz.Note[Gracz.HighNote].Start), 'NewBeat'); - end - else - begin - // przedluzenie nuty - Player[CP].Note[Player[CP].HighNote].Length := Player[CP].Note[Player[CP].HighNote].Length + 1; - end; - - // check for perfect note and then lit the star (on Draw) - for Count := 0 to Lines[0].Line[S].HighNote do - begin - if (Lines[0].Line[S].Note[Count].Start = Player[CP].Note[Player[CP].HighNote].Start) and - (Lines[0].Line[S].Note[Count].Length = Player[CP].Note[Player[CP].HighNote].Length) and - (Lines[0].Line[S].Note[Count].Tone = Player[CP].Note[Player[CP].HighNote].Tone) then - begin - Player[CP].Note[Player[CP].HighNote].Perfect := true; - end; - end; - end; // if S = SMax - - end; // if moze - end; // for CP - // Log.LogStatus('EndBeat', 'NewBeat'); - - //On Sentence End -> For LineBonus + SingBar - if (sDet >= low(Lines[0].Line)) and (sDet <= high(Lines[0].Line)) then - begin - if assigned( Sender ) and - ((Lines[0].Line[SDet].Note[Lines[0].Line[SDet].HighNote].Start + Lines[0].Line[SDet].Note[Lines[0].Line[SDet].HighNote].Length - 1) = LineState.CurrentBeatD) then - begin - Sender.onSentenceEnd(sDet); - end; - end; - +var + CP: integer; // current player + S: integer; // sentence + SMin: integer; + SMax: integer; + SDet: integer; // temporary: sentence of detected note + Count: integer; + Mozna: boolean; + New: boolean; + Range: integer; + NoteHit:boolean; + MaxPoints: integer; // maximal points without line bonus +begin + // Log.LogStatus('Beat ' + IntToStr(LineState.CurrentBeat) + ' HalfBeat ' + IntToStr(LineState.AktHalf), 'NewBeat'); + + // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas + if not assigned( AudioInputProcessor.Sound ) then + exit; + + // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth) + // albo juz lepiej nie + for CP := 0 to PlayersPlay-1 do + begin + // analyze buffer + AudioInputProcessor.Sound[CP].AnalyzeBuffer; + + // adds some noise + //LineState.Tone := LineState.Tone + Round(Random(3)) - 1; + + // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SMin := Lines[0].Current-1; + if SMin < 0 then + SMin := 0; + SMax := Lines[0].Current; + + // check if we can add new note + Mozna := false; + SDet:=SMin; + for S := SMin to SMax do + begin + for Count := 0 to Lines[0].Line[S].HighNote do + begin + if ((Lines[0].Line[S].Note[Count].Start <= LineState.CurrentBeatD) + and (Lines[0].Line[S].Note[Count].Start + Lines[0].Line[S].Note[Count].Length - 1 >= LineState.CurrentBeatD)) + and (Lines[0].Line[S].Note[Count].NoteType <> ntFreestyle) // but don't allow when it's FreeStyle note + and (Lines[0].Line[S].Note[Count].Length > 0) then // and make sure the note lengths is at least 1 + begin + SDet := S; + Mozna := true; + Break; + end; + end; + end; + + S := SDet; + + //Czas.SzczytJest := true; + //Czas.Tone := 27; + + // gdy moze, to dodaje nute - When Mozna, it adds note (?) + if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then + begin + // operowanie na ostatniej nucie + for Count := 0 to Lines[0].Line[S].HighNote do + begin + if (Lines[0].Line[S].Note[Count].Start <= LineState.OldBeatD+1) and + (Lines[0].Line[S].Note[Count].Start + + Lines[0].Line[S].Note[Count].Length > LineState.OldBeatD+1) then + begin + // to robi, tylko dla pary nut (oryginalnej i gracza) + + // przesuwanie tonu w odpowiednia game + while (AudioInputProcessor.Sound[CP].Tone - Lines[0].Line[S].Note[Count].Tone > 6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12; + + while (AudioInputProcessor.Sound[CP].Tone - Lines[0].Line[S].Note[Count].Tone < -6) do + AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone + 12; + + // Half size Notes Patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + if abs(Lines[0].Line[S].Note[Count].Tone - AudioInputProcessor.Sound[CP].Tone) <= Range then + begin + AudioInputProcessor.Sound[CP].Tone := Lines[0].Line[S].Note[Count].Tone; + + // Half size Notes Patch + NoteHit := true; + + MaxPoints := 10000; + if (Ini.LineBonus <> 0) then + MaxPoints := 9000; + + case Lines[0].Line[S].Note[Count].NoteType of + ntNormal: Player[CP].Score := Player[CP].Score + MaxPoints / Lines[0].ScoreValue * + Lines[0].Line[S].Note[Count].Length; + ntGolden: Player[CP].ScoreGolden := Player[CP].ScoreGolden + MaxPoints / Lines[0].ScoreValue * + (Lines[0].Line[S].Note[Count].Length * 2); + end; + + Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10; + Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10; + + Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI; + end; + + end; // operowanie + end; // for + + // sprawdzanie czy to nowa nuta, czy przedluzenie + if S = SMax then + begin + New := true; + // if last has the same tone + if (Player[CP].IlNut > 0 ) and + (Player[CP].Note[Player[CP].HighNote].Tone = AudioInputProcessor.Sound[CP].Tone) and + (Player[CP].Note[Player[CP].HighNote].Start + Player[CP].Note[Player[CP].HighNote].Length = LineState.CurrentBeatD) then + begin + New := false; + end; + + // if is not as new note to control "beacie" (TODO: translate polish "beacie") + for Count := 0 to Lines[0].Line[S].HighNote do + begin + if (Lines[0].Line[S].Note[Count].Start = LineState.CurrentBeatD) then + New := true; + end; + + // dodawanie nowej nuty + if New then + begin + // New Note + Player[CP].IlNut := Player[CP].IlNut + 1; + Player[CP].HighNote := Player[CP].HighNote + 1; + SetLength(Player[CP].Note, Player[CP].IlNut); + Player[CP].Note[Player[CP].HighNote].Start := LineState.CurrentBeatD; + Player[CP].Note[Player[CP].HighNote].Length := 1; + Player[CP].Note[Player[CP].HighNote].Tone := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl + Player[CP].Note[Player[CP].HighNote].Detekt := LineState.MidBeat; + + // Half Note Patch + Player[CP].Note[Player[CP].HighNote].Hit := NoteHit; + + //Log.LogStatus('New Note ' + IntToStr(Gracz.Note[Gracz.HighNote].Start), 'NewBeat'); + end + else + begin + // przedluzenie nuty + Player[CP].Note[Player[CP].HighNote].Length := Player[CP].Note[Player[CP].HighNote].Length + 1; + end; + + // check for perfect note and then lit the star (on Draw) + for Count := 0 to Lines[0].Line[S].HighNote do + begin + if (Lines[0].Line[S].Note[Count].Start = Player[CP].Note[Player[CP].HighNote].Start) and + (Lines[0].Line[S].Note[Count].Length = Player[CP].Note[Player[CP].HighNote].Length) and + (Lines[0].Line[S].Note[Count].Tone = Player[CP].Note[Player[CP].HighNote].Tone) then + begin + Player[CP].Note[Player[CP].HighNote].Perfect := true; + end; + end; + end; // if S = SMax + + end; // if moze + end; // for CP + // Log.LogStatus('EndBeat', 'NewBeat'); + + //On Sentence End -> For LineBonus + SingBar + if (sDet >= low(Lines[0].Line)) and (sDet <= high(Lines[0].Line)) then + begin + if assigned( Sender ) and + ((Lines[0].Line[SDet].Note[Lines[0].Line[SDet].HighNote].Start + Lines[0].Line[SDet].Note[Lines[0].Line[SDet].HighNote].Length - 1) = LineState.CurrentBeatD) then + begin + Sender.onSentenceEnd(sDet); + end; + end; + end; procedure ClearScores(PlayerNum: integer); @@ -1097,7 +1098,7 @@ begin initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim ); initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim ); initialize_path( VisualsPath , Platform.GetGameSharedPath + 'Visuals' + PathDelim ); - + initialize_path( ResourcesPath , Platform.GetGameSharedPath + 'Resources' + PathDelim ); initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim ); // Users Song Path .... diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 712c54bf..3fac0524 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -131,12 +131,6 @@ implementation uses ULog, DateUtils, UThemes, - {$ifdef LINUX} - fileutil, - {$endif} - {$IFDEF LCL} - LResources, - {$ENDIF} {$IFDEF DARWIN} MacResources, {$ENDIF} @@ -186,6 +180,7 @@ end; end; Result := stream.Seek( offset, origin ); end; + function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; var stream : TStream; @@ -199,6 +194,7 @@ end; Result := -1; end; end; + function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; var stream : TStream; @@ -212,36 +208,10 @@ end; // ----------------------------------------------- function TTextureUnit.LoadImage(const Identifier: string): PSDL_Surface; - - function FileExistsInsensative( var aFileName : PChar ): boolean; - begin -{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems - result := true; - - if FileExists( aFileName ) then - exit; - - aFileName := pchar( FindDiskFileCaseInsensitive( aFileName ) ); - result := FileExists( aFileName ); -{$ELSE} - result := FileExists( aFileName ); -{$ENDIF} - end; - var - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LCL} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} TexStream: TStream; - {$ENDIF} - - lFileName : pchar; - + FileName: string; begin Result := nil; TexRWops := nil; @@ -249,100 +219,61 @@ begin if Identifier = '' then exit; - lFileName := PChar(Identifier); - -// Log.LogStatus( Identifier, 'LoadImage' ); + //Log.LogStatus( Identifier, 'LoadImage' ); -// Log.LogStatus( 'Looking for File ( Loading : '+Identifier+' - '+ FindDiskFileCaseInsensitive(Identifier) +')', ' LoadImage' ); + FileName := Identifier; - if ( FileExistsInsensative(lFileName) ) then + if (FileExistsInsensitive(FileName)) then begin // load from file - Log.LogStatus( 'Is File ( Loading : '+lFileName+')', ' LoadImage' ); + //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' ); try - Result:=IMG_Load(lFileName); - Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + Result := IMG_Load(PChar(FileName)); + //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); + Log.LogError('Could not load from file "'+FileName+'"', 'TTextureUnit.LoadImage'); Exit; end; end else begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - // load from resource stream - {$IFDEF LCL} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, PChar(Identifier), 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - Exit; - end; + TexStream := GetResourceStream(Identifier, 'TEX'); + if (not assigned(TexStream)) then + begin + Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'TTextureUnit.LoadImage'); + Exit; + end; + TexRWops := SDL_AllocRW(); + if (TexRWops = nil) then + begin + Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.LoadImage'); + TexStream.Free(); + Exit; + end; - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - Exit; - end; + // user defined RW-callbacks + with TexRWops^ do + begin + unknown := TUnknown(TexStream); + seek := SDLStreamSeek; + read := SDLStreamRead; + write := nil; + close := SDLStreamClose; + type_ := 2; + end; - try - TexStream.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown(TexStream); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} + //Log.LogStatus( 'resource Assigned....' , Identifier); + try + Result := IMG_Load_RW(TexRWops, 0); + except + Log.LogError( 'Could not read resource "'+Identifier+'"', 'TTextureUnit.LoadImage'); + end; + + SDL_FreeRW(TexRWops); + TexStream.Free(); end; end; @@ -1019,10 +950,4 @@ begin Result := TEXTURE_TYPE_PLAIN; end; -{$IFDEF LCL} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - end. diff --git a/Game/Code/Makefile.in b/Game/Code/Makefile.in index 1529c002..1e895beb 100644 --- a/Game/Code/Makefile.in +++ b/Game/Code/Makefile.in @@ -49,29 +49,30 @@ PLIBS = @PLIBS@ PPLATFORM = @FPC_PLATFORM@ PPROCESSOR = @FPC_PROCESSOR@ +# TODO: remove lazarus stuff # lazarus defines -LAZARUS_DIR = @LAZARUS_DIR@ -LCL_WIDGET_TYPE = @LCL_WIDGET_TYPE@ -PROJ_SUFFIX = .lpr - -# RC to LRS resource compiler -RESCOMPILER_NAME = USDXResCompiler -RESCOMPILER_BIN = $(USDX_TOOLS_DIR)/$(RESCOMPILER_NAME)$(EXE_SUFFIX) -RESCOMPILER_SRC = $(USDX_TOOLS_DIR)/$(RESCOMPILER_NAME)$(PROJ_SUFFIX) -RESCOMPILER_PFLAGS = -dRELEASE +#LAZARUS_DIR = @LAZARUS_DIR@ +#LCL_WIDGET_TYPE = @LCL_WIDGET_TYPE@ +# $(PUNIT_TOKEN)$(LAZARUS_DIR)/lcl/units/$(PPROCESSOR)-$(PPLATFORM) +# $(PUNIT_TOKEN)$(LAZARUS_DIR)/lcl/units/$(PPROCESSOR)-$(PPLATFORM)/$(LCL_WIDGET_TYPE) + +# RC resource extraction config +RESEXTRACTOR_NAME = ResourceExtractor +RESEXTRACTOR_DIR = $(USDX_TOOLS_DIR)/$(RESEXTRACTOR_NAME) +RESEXTRACTOR_BIN = $(RESEXTRACTOR_DIR)/$(RESEXTRACTOR_NAME)$(EXE_SUFFIX) +RESEXTRACTOR_SRC = $(RESEXTRACTOR_DIR)/$(RESEXTRACTOR_NAME).pas +RESEXTRACTOR_PFLAGS = -dRELEASE +RESOURCE_DIR = $(usdxrootdir)/Resources +RESOURCE_FILE = resource.inc # Directories added to the unit path PUNIT_TOKEN = -Fu PUNIT_FLAGS = \ - $(PUNIT_TOKEN)$(LAZARUS_DIR)/lcl/units/$(PPROCESSOR)-$(PPLATFORM) \ - $(PUNIT_TOKEN)$(LAZARUS_DIR)/components/images/lib/$(PPROCESSOR)-$(PPLATFORM) \ - $(PUNIT_TOKEN)$(LAZARUS_DIR)/components/jpeg \ - $(PUNIT_TOKEN)$(LAZARUS_DIR)/lcl/units/$(PPROCESSOR)-$(PPLATFORM)/$(LCL_WIDGET_TYPE) \ $(PUNIT_TOKEN). - + # Directory where compiled units (.ppu and .o files) are stored PCUNIT_TOKEN = -FU -PCUNIT_DIR = ./build/$(PPLATFORM)/lazarus +PCUNIT_DIR = ./build/$(PPLATFORM)/fpc PCUNIT_FLAGS = $(PCUNIT_TOKEN)$(PCUNIT_DIR) # Directories added to the includes path @@ -79,7 +80,7 @@ PINC_TOKEN = -Fi PINC_FLAGS = $(PINC_TOKEN)lib/JEDI-SDL/SDL/Pas # Defines -PDEFINES = -dLCL -dLCL$(LCL_WIDGET_TYPE) +#PDEFINES = -dLCL -dLCL$(LCL_WIDGET_TYPE) # FPC flags @@ -98,8 +99,8 @@ PFLAGS_RELEASE = @PFLAGS_RELEASE@ PFLAGS_EXTRA = PFLAGS += $(PFLAGS_EXTRA) -# lpr project file used as input -USDX_SRC = $(USDX_PREFIX)$(PROJ_SUFFIX) +# dpr project file used as input +USDX_SRC = $(USDX_PREFIX).dpr # name of executable USDX_BIN_NAME = $(USDX_PREFIX)$(EXE_SUFFIX) USDX_BIN = $(usdxrootdir)/$(USDX_BIN_NAME) @@ -108,7 +109,7 @@ USDX_BIN = $(usdxrootdir)/$(USDX_BIN_NAME) all: resources ultrastardx-app -resources: $(USDX_PREFIX).lrs +resources: $(RESOURCE_FILE) ultrastardx-app: $(USDX_BIN) @@ -161,6 +162,7 @@ install-data: $(MAKE) RECURSIVE_SRC_DIR=$(usdxrootdir)/Sounds RECURSIVE_DST_DIR=$(INSTALL_datadir)/Sounds install-data-recursive $(MAKE) RECURSIVE_SRC_DIR=$(usdxrootdir)/Languages RECURSIVE_DST_DIR=$(INSTALL_datadir)/Languages install-data-recursive $(MAKE) RECURSIVE_SRC_DIR=$(usdxrootdir)/Skins RECURSIVE_DST_DIR=$(INSTALL_datadir)/Skins install-data-recursive + $(MAKE) RECURSIVE_SRC_DIR=$(usdxrootdir)/Resources RECURSIVE_DST_DIR=$(INSTALL_datadir)/Resources install-data-recursive $(MAKE) RECURSIVE_SRC_DIR=$(usdxrootdir)/InstallerDependencies/Visuals RECURSIVE_DST_DIR=$(INSTALL_datadir)/Visuals install-data-recursive install-data-recursive: @@ -188,6 +190,7 @@ uninstall-data: rm -rf $(INSTALL_datadir)/Sounds rm -rf $(INSTALL_datadir)/Languages rm -rf $(INSTALL_datadir)/Skins + rm -rf $(INSTALL_datadir)/Resources rm -rf $(INSTALL_datadir)/Visuals rmdir $(INSTALL_datadir) @@ -246,14 +249,14 @@ clean_obj: rm -f $(USDX_BIN) clean_res: - rm -f $(USDX_PREFIX).lrs + rm -f $(RESOURCE_FILE) -$(USDX_PREFIX).lrs: $(RESCOMPILER_BIN) $(USDX_PREFIX).rc - $(RESCOMPILER_BIN) $(USDX_PREFIX).rc +$(RESOURCE_FILE): $(RESEXTRACTOR_BIN) $(USDX_PREFIX).rc + $(RESEXTRACTOR_BIN) $(USDX_PREFIX).rc $(RESOURCE_DIR) $(RESOURCE_FILE) -$(RESCOMPILER_BIN): $(RESCOMPILER_SRC) +$(RESEXTRACTOR_BIN): $(RESEXTRACTOR_SRC) mkdir -p $(PCUNIT_DIR) - $(PPC) $(RESCOMPILER_PFLAGS) $(PUNIT_FLAGS) $(PCUNIT_FLAGS) -o$@ $(RESCOMPILER_SRC) + $(PPC) $(RESEXTRACTOR_PFLAGS) $(PUNIT_FLAGS) $(PCUNIT_FLAGS) -o$@ $(RESEXTRACTOR_SRC) configure: configure.ac config.inc.in aclocal.m4 autoconf diff --git a/Game/Code/USDXResCompiler.exe b/Game/Code/USDXResCompiler.exe deleted file mode 100644 index 43e7fc8a..00000000 Binary files a/Game/Code/USDXResCompiler.exe and /dev/null differ diff --git a/Game/Code/configure.ac b/Game/Code/configure.ac index ae20db31..3c4322b4 100644 --- a/Game/Code/configure.ac +++ b/Game/Code/configure.ac @@ -37,23 +37,23 @@ AC_ARG_WITH([cfg-dummy1], [ External Libraries:]) # add lazarus option -AC_ARG_WITH([lazarus], - [AS_HELP_STRING([--with-lazarus=DIR], - [Directory of lazarus @<:@LAZARUSDIR@:>@])], - [with_lazarus=$withval], [with_lazarus="yes"]) -if [[ x$with_lazarus = xno ]] ; then - AC_MSG_ERROR([Lazarus is required. It is impossible to build without it.]); -fi +#AC_ARG_WITH([lazarus], +# [AS_HELP_STRING([--with-lazarus=DIR], +# [Directory of lazarus @<:@LAZARUSDIR@:>@])], +# [with_lazarus=$withval], [with_lazarus="yes"]) +#if [[ x$with_lazarus = xno ]] ; then +# AC_MSG_ERROR([Lazarus is required. It is impossible to build without it.]); +#fi # add lazarus widget-type option # the result is not used at the moment -AC_ARG_WITH([lcl-widget-type], - [AS_HELP_STRING([--with-lcl-widget-type=TYPE], - [Lazarus LCL Widget Type @<:@default=check@:>@])], - [with_lcl_widget_type=$withval], [with_lcl_widget_type=""]) -if [[ x$with_lcl_widget_type = xno -o x$with_lcl_widget_type = xyes ]] ; then - AC_MSG_ERROR([Invalid LCL Widget Type (try one of gtk2/gtk/qt)]); -fi +#AC_ARG_WITH([lcl-widget-type], +# [AS_HELP_STRING([--with-lcl-widget-type=TYPE], +# [Lazarus LCL Widget Type @<:@default=check@:>@])], +# [with_lcl_widget_type=$withval], [with_lcl_widget_type=""]) +#if [[ x$with_lcl_widget_type = xno -o x$with_lcl_widget_type = xyes ]] ; then +# AC_MSG_ERROR([Invalid LCL Widget Type (try one of gtk2/gtk/qt)]); +#fi # add portaudio option AC_ARG_WITH([portaudio], @@ -293,66 +293,66 @@ fi # ----------------------------------------- # set dirs to check for lazarus -if [[ x$with_lazarus = xyes ]]; then +#if [[ x$with_lazarus = xyes ]]; then # use default path (ignore the standard path (PATH) because the lazarus executable might # be in /usr/bin, but what we want is the program directory with the libs) - LAZARUS_CHECK_DIRS="/usr/bin/lazarus:/usr/lib/lazarus:/usr/share/lazarus:/opt/lazarus:/usr/local/bin/lazarus:/usr/local/lib/lazarus:/usr/local/share/lazarus" -else +# LAZARUS_CHECK_DIRS="/usr/bin/lazarus:/usr/lib/lazarus:/usr/share/lazarus:/opt/lazarus:/usr/local/bin/lazarus:/usr/local/lib/lazarus:/usr/local/share/lazarus" +#else # check if dir is valid - if [[ -d $with_lazarus ]] ; then - LAZARUS_CHECK_DIRS=$with_lazarus - else - AC_MSG_ERROR([LAZARUSDIR is not a directory.]); - fi -fi +# if [[ -d $with_lazarus ]] ; then +# LAZARUS_CHECK_DIRS=$with_lazarus +# else +# AC_MSG_ERROR([LAZARUSDIR is not a directory.]); +# fi +#fi # find lazarus -AC_PATH_PROG(LAZARUS, lazarus, no, [$LAZARUS_CHECK_DIRS]) -if [[ $LAZARUS = "no" ]] ; then - AC_MSG_ERROR([Could not find lazarus. Please install lazarus and try again.]); -fi -LAZARUS_DIR=`AS_DIRNAME(["$LAZARUS"])` +#AC_PATH_PROG(LAZARUS, lazarus, no, [$LAZARUS_CHECK_DIRS]) +#if [[ $LAZARUS = "no" ]] ; then +# AC_MSG_ERROR([Could not find lazarus. Please install lazarus and try again.]); +#fi +#LAZARUS_DIR=`AS_DIRNAME(["$LAZARUS"])` # get lazarus version -AC_MSG_CHECKING(for version of lazarus) +#AC_MSG_CHECKING(for version of lazarus) # (do this in a temporary shell to prevent a change of directory) -LAZARUS_VERSION=`(cd "$LAZARUS_DIR/tools/install"; ./get_lazarus_version.sh)` +#LAZARUS_VERSION=`(cd "$LAZARUS_DIR/tools/install"; ./get_lazarus_version.sh)` #LAZARUS_VERSION=`cat ide/version.inc | tr -d "' \t"` -AC_SPLIT_VERSION([LAZARUS], [$LAZARUS_VERSION]) -AC_MSG_RESULT(@<:@$LAZARUS_VERSION@:>@) +#AC_SPLIT_VERSION([LAZARUS], [$LAZARUS_VERSION]) +#AC_MSG_RESULT(@<:@$LAZARUS_VERSION@:>@) # check if LCL Widget type is valid -if [[ x$with_lcl_widget_type = x ]]; then - # search for standard types - LCL_CHECK_WIDGET_TYPES="gtk2 gtk qt win32 carbon" -else +#if [[ x$with_lcl_widget_type = x ]]; then +# # search for standard types +# LCL_CHECK_WIDGET_TYPES="gtk2 gtk qt win32 carbon" +#else # search for user defined type only - LCL_CHECK_WIDGET_TYPES="$with_lcl_widget_type" -fi +# LCL_CHECK_WIDGET_TYPES="$with_lcl_widget_type" +#fi # LCL widget specific base dir -LCL_UNIT_DIR="$LAZARUS_DIR/lcl/units/$FPC_PROCESSOR-$FPC_PLATFORM" +#LCL_UNIT_DIR="$LAZARUS_DIR/lcl/units/$FPC_PROCESSOR-$FPC_PLATFORM" # check for a supported widget type -LCL_WIDGET_TYPE="" -for widget_type in $LCL_CHECK_WIDGET_TYPES; do - widget_dir="$LCL_UNIT_DIR/$widget_type" - AC_MSG_CHECKING([whether LCL Widget Type "$widget_type" is supported]) - if [[ -d "$widget_dir" ]]; then - LCL_WIDGET_TYPE=$widget_type - AC_MSG_RESULT(yes) - break - else - AC_MSG_RESULT(no) - fi -done +#LCL_WIDGET_TYPE="" +#for widget_type in $LCL_CHECK_WIDGET_TYPES; do +# widget_dir="$LCL_UNIT_DIR/$widget_type" +# AC_MSG_CHECKING([whether LCL Widget Type "$widget_type" is supported]) +# if [[ -d "$widget_dir" ]]; then +# LCL_WIDGET_TYPE=$widget_type +# AC_MSG_RESULT(yes) +# break +# else +# AC_MSG_RESULT(no) +# fi +#done # check if a widget type was found -if [[ x$LCL_WIDGET_TYPE = x ]]; then - AC_MSG_ERROR([ -!!! Could not detect the LCL Widget Type. -!!! Specify the widget type with the --with-lcl-widget-type option.]) -fi +#if [[ x$LCL_WIDGET_TYPE = x ]]; then +# AC_MSG_ERROR([ +#!!! Could not detect the LCL Widget Type. +#!!! Specify the widget type with the --with-lcl-widget-type option.]) +#fi # ----------------------------------------- # check for libraries @@ -428,8 +428,8 @@ AC_SUBST_DEFINE(HAVE_PORTAUDIO, $PORTAUDIO_HAVE) AC_SUBST(PORTMIXER_LIB) AC_SUBST_DEFINE(HAVE_PORTMIXER, $PORTMIXER_HAVE) -AC_SUBST(LAZARUS_DIR) -AC_SUBST(LCL_WIDGET_TYPE) +#AC_SUBST(LAZARUS_DIR) +#AC_SUBST(LCL_WIDGET_TYPE) AC_SUBST_DEFINE(USE_LOCAL_DIRS, $enable_dev_build) if [[ x$enable_dev_build = xyes ]]; then -- cgit v1.2.3