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

1 files changed, 172 insertions, 78 deletions

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.