Start implementing support for 32bit sprites concerned in map generation process.
authorunc0rr
Fri, 08 Aug 2008 19:34:55 +0000
changeset 1180 e56317fdf78d
parent 1179 bdf8b68b1dd1
child 1181 3ae244bffef9
Start implementing support for 32bit sprites concerned in map generation process. Step 1: forts are loading correctly. Everything else is broken
hedgewars/uLand.pas
hedgewars/uLandObjects.pas
hedgewars/uMisc.pas
hedgewars/uStore.pas
share/hedgewars/Data/Forts/BarrelhouseL.png
share/hedgewars/Data/Forts/BarrelhouseR.png
share/hedgewars/Data/Forts/IslandL.png
share/hedgewars/Data/Forts/IslandR.png
--- a/hedgewars/uLand.pas	Fri Aug 08 13:46:12 2008 +0000
+++ b/hedgewars/uLand.pas	Fri Aug 08 19:34:55 2008 +0000
@@ -24,7 +24,6 @@
      TPreview = packed array[0..127, 0..31] of byte;
 
 var  Land: TLandArray;
-     LandSurface: PSDL_Surface;
      LandPixels: TLandArray;
      LandTexture: PTexture = nil;
 
@@ -509,6 +508,20 @@
 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))
 end;
 
+procedure LandSurface2Land(LandSurface: PSDL_Surface);
+begin
+TryDo(LandSurface <> nil, 'Assert (LandSurface <> nil) failed', true);
+LandTexture:= Surface2Tex(LandSurface);
+
+if SDL_MustLock(LandSurface) then
+	SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
+
+Move(LandSurface^.pixels^, LandPixels, 2048 * 1024 * 4);
+
+if SDL_MustLock(LandSurface) then
+	SDL_UnlockSurface(LandSurface)
+end;
+
 procedure GenLandSurface;
 var tmpsurf: PSDL_Surface;
 begin
@@ -522,19 +535,16 @@
 
 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
 ColorizeLand(tmpsurf);
-AddProgress;
 AddBorder(tmpsurf);
 
-LandSurface:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, AMask);
-
-TryDo(LandSurface <> nil, 'Error creating land surface', true);
-SDL_FillRect(LandSurface, nil, 0);
-AddProgress;
-SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
-AddObjects(tmpsurf, LandSurface);
+LandSurface2Land(tmpsurf);
 SDL_FreeSurface(tmpsurf);
 
-UpdateLandTexture(0, 1024);
+AddProgress;
+
+AddObjects;
+
+UpdateLandTexture(0, 1023);
 AddProgress
 end;
 
@@ -544,57 +554,43 @@
 WriteLnToConsole('Generating forts land...');
 TryDo(ClansCount = 2, 'More or less than 2 clans on map in forts mode!', true);
 
-LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, AMask);
-
-SDL_FillRect(LandSurface, nil, 0);
-
-tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', false, true, true);
-BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
+tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', true, true, true);
+BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf);
 SDL_FreeSurface(tmpsurf);
 
-tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'R', false, true, true);
-BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
+tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'R', true, true, true);
+BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf);
 SDL_FreeSurface(tmpsurf);
 
-UpdateLandTexture(0, 1024)
+UpdateLandTexture(0, 1023)
 end;
 
 procedure LoadMap;
 var x, y: Longword;
     p: PByteArray;
+    LandSurface: PSDL_Surface;
 begin
 WriteLnToConsole('Loading land from file...');
 AddProgress;
-LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false, true, true);
+LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', true, true, true);
 TryDo((LandSurface^.w = 2048) and (LandSurface^.h = 1024), 'Map dimensions should be 2048x1024!', true);
 
 if SDL_MustLock(LandSurface) then
-   SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
+	SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
+
+TryDo(LandSurface^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);
 
-p:= LandSurface^.pixels;
-case LandSurface^.format^.BytesPerPixel of
-     1: OutError('We don''t work with 8 bit surfaces', true);
-     2: OutError('We don''t work with 16 bit surfaces', true);
-     3: for y:= 0 to 1023 do
-            begin
-            for x:= 0 to 2047 do
-                if  (p^[x * 3 + 0] <> 0)
-                 or (p^[x * 3 + 1] <> 0)
-                 or (p^[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND;
-            p:= @(p^[LandSurface^.pitch]);
-            end;
-     4: for y:= 0 to 1023 do
-            begin
-            for x:= 0 to 2047 do
-                if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[y, x]:= COLOR_LAND;
-            p:= @(p^[LandSurface^.pitch]);
-            end;
-     end;
+for y:= 0 to 1023 do
+	begin
+	for x:= 0 to 2047 do
+		if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[y, x]:= COLOR_LAND;
+	p:= @(p^[LandSurface^.pitch]);
+	end;
 
 if SDL_MustLock(LandSurface) then
-   SDL_UnlockSurface(LandSurface);
+	SDL_UnlockSurface(LandSurface);
 
-UpdateLandTexture(0, 1024)
+UpdateLandTexture(0, 1023)
 end;
 
 procedure GenMap;
@@ -634,31 +630,17 @@
 
 procedure UpdateLandTexture(Y, Height: LongInt);
 begin
-if LandTexture <> nil then
-   begin
-   if (Height <= 0) then exit;
-   TryDo((Y >= 0) and (Y < 1024), 'UpdateLandTexture: wrong Y parameter', true);
-   TryDo(Y + Height < 1024, 'UpdateLandTexture: wrong Height parameter', true);
-   glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
-
-   glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, 2048, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]);
-   end else
-   begin
-   TryDo(LandSurface <> nil, 'Assert (LandSurface <> nil) failed', true);
-   LandTexture:= Surface2Tex(LandSurface);
+if (Height <= 0) then exit;
+TryDo((Y >= 0) and (Y < 1024), 'UpdateLandTexture: wrong Y parameter', true);
+TryDo(Y + Height < 1024, 'UpdateLandTexture: wrong Height parameter', true);
 
-   if SDL_MustLock(LandSurface) then
-      SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
-
-   Move(LandSurface^.pixels^, LandPixels, 2048 * 1024 * 4);
-
-   if SDL_MustLock(LandSurface) then
-      SDL_UnlockSurface(LandSurface);
-
-   SDL_FreeSurface(LandSurface);
-   LandSurface:= nil
-   end;
-
+if LandTexture = nil then
+	LandTexture:= NewTexture(2048, 1024, @LandPixels)
+else
+	begin
+	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
+	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, 2048, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]);
+	end
 end;
 
 initialization
--- a/hedgewars/uLandObjects.pas	Fri Aug 08 13:46:12 2008 +0000
+++ b/hedgewars/uLandObjects.pas	Fri Aug 08 19:34:55 2008 +0000
@@ -21,9 +21,9 @@
 uses SDLh;
 {$include options.inc}
 
-procedure AddObjects(InSurface, Surface: PSDL_Surface);
+procedure AddObjects();
 procedure LoadThemeConfig;
-procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
+procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
 
 implementation
 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom, uVisualGears, uFloat, GL, uSound;
@@ -61,7 +61,7 @@
     SprayObjects: TSprayObjects;
 
 
-procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
+procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
 var p: PByteArray;
     x, y: Longword;
     bpp: LongInt;
@@ -69,38 +69,26 @@
 begin
 r.x:= cpX;
 r.y:= cpY;
-SDL_UpperBlit(Image, nil, Surface, @r);
 WriteToConsole('Generating collision info... ');
 
 if SDL_MustLock(Image) then
    SDLTry(SDL_LockSurface(Image) >= 0, true);
 
 bpp:= Image^.format^.BytesPerPixel;
-WriteToConsole('('+inttostr(bpp)+') ');
+TryDo(bpp = 4, 'Land object should be 32bit', true);
 p:= Image^.pixels;
-case bpp of
-     1: OutError('We don''t work with 8 bit surfaces', true);
-     2: for y:= 0 to Pred(Image^.h) do
-            begin
-            for x:= 0 to Pred(Image^.w) do
-                if PWord(@(p^[x * 2]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
-            p:= @(p^[Image^.pitch]);
-            end;
-     3: for y:= 0 to Pred(Image^.h) do
-            begin
-            for x:= 0 to Pred(Image^.w) do
-                if  (p^[x * 3 + 0] <> 0)
-                 or (p^[x * 3 + 1] <> 0)
-                 or (p^[x * 3 + 2] <> 0) then Land[cpY + y, cpX + x]:= COLOR_LAND;
-            p:= @(p^[Image^.pitch]);
-            end;
-     4: for y:= 0 to Pred(Image^.h) do
-            begin
-            for x:= 0 to Pred(Image^.w) do
-                if PLongword(@(p^[x * 4]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
-            p:= @(p^[Image^.pitch]);
-            end;
-     end;
+
+for y:= 0 to Pred(Image^.h) do
+	begin
+	for x:= 0 to Pred(Image^.w) do
+		//if LandPixels[cpY + y, cpX + x] = 0 then
+			begin
+			LandPixels[cpY + y, cpX + x]:= PLongword(@(p^[x * 4]))^;
+			if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
+			end;
+	p:= @(p^[Image^.pitch]);
+	end;
+
 if SDL_MustLock(Image) then
    SDL_UnlockSurface(Image);
 WriteLnToConsole(msgOK)
@@ -257,7 +245,7 @@
 CheckCanPlace:= Result
 end;
 
-function TryPut(var Obj: TThemeObject; Surface: PSDL_Surface): boolean; overload;
+function TryPut(var Obj: TThemeObject): boolean; overload;
 const MaxPointsIndex = 2047;
 var x, y: Longword;
     ar: array[0..MaxPointsIndex] of TPoint;
@@ -292,7 +280,7 @@
      if Result then
         begin
         i:= getrandom(cnt);
-        BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf, Surface);
+        BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf);
         AddRect(ar[i].x, ar[i].y, Width, Height);
         dec(Maxcnt)
         end else Maxcnt:= 0
@@ -436,7 +424,7 @@
     repeat
       inc(ii);
       if ii = ThemeObjects.Count then ii:= 0;
-      b:= TryPut(ThemeObjects.objs[ii], Surface)
+      b:= TryPut(ThemeObjects.objs[ii])
     until b or (ii = t);
     inc(i)
 until (i > MaxCount) or not b;
@@ -462,9 +450,9 @@
 until (i > MaxCount) or not b;
 end;
 
-procedure AddObjects(InSurface, Surface: PSDL_Surface);
+procedure AddObjects();
 begin
-InitRects;
+{InitRects;
 AddGirder(256, Surface);
 AddGirder(512, Surface);
 AddGirder(768, Surface);
@@ -476,7 +464,7 @@
 AddProgress;
 SDL_UpperBlit(InSurface, nil, Surface, nil);
 AddSprayObjects(Surface, SprayObjects, 10);
-FreeRects
+FreeRects}
 end;
 
 procedure LoadThemeConfig;
--- a/hedgewars/uMisc.pas	Fri Aug 08 13:46:12 2008 +0000
+++ b/hedgewars/uMisc.pas	Fri Aug 08 19:34:55 2008 +0000
@@ -120,6 +120,7 @@
 procedure SetLittle(var r: hwFloat);
 procedure SendStat(sit: TStatInfoType; s: shortstring);
 function  Str2PChar(const s: shortstring): PChar;
+function NewTexture(width, height: Longword; buf: Pointer): PTexture;
 function  Surface2Tex(surf: PSDL_Surface): PTexture;
 procedure FreeTexture(tex: PTexture);
 function  toPowerOf2(i: Longword): Longword;
@@ -267,6 +268,22 @@
 while (toPowerOf2 < i) do toPowerOf2:= toPowerOf2 shl 1
 end;
 
+function NewTexture(width, height: Longword; buf: Pointer): PTexture;
+begin
+new(NewTexture);
+NewTexture^.w:= width;
+NewTexture^.h:= height;
+
+glGenTextures(1, @NewTexture^.id);
+
+glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
+
+glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
+
+glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
+end;
+
 function Surface2Tex(surf: PSDL_Surface): PTexture;
 var mode: LongInt;
     tw, th: Longword;
--- a/hedgewars/uStore.pas	Fri Aug 08 13:46:12 2008 +0000
+++ b/hedgewars/uStore.pas	Fri Aug 08 19:34:55 2008 +0000
@@ -506,9 +506,7 @@
     end;
 
 FreeTexture(HHTexture);
-FreeTexture(LandTexture);
-
-SDL_FreeSurface(LandSurface)
+FreeTexture(LandTexture)
 end;
 
 function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
Binary file share/hedgewars/Data/Forts/BarrelhouseL.png has changed
Binary file share/hedgewars/Data/Forts/BarrelhouseR.png has changed
Binary file share/hedgewars/Data/Forts/IslandL.png has changed
Binary file share/hedgewars/Data/Forts/IslandR.png has changed