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/UTexture.pas | 250 ++++++++++++++++++++++++++++------------- 1 file changed, 172 insertions(+), 78 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') 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