hedgewars/uLandObjects.pas
changeset 1180 e56317fdf78d
parent 1156 3b51492e77f9
child 1181 3ae244bffef9
equal deleted inserted replaced
1179:bdf8b68b1dd1 1180:e56317fdf78d
    19 unit uLandObjects;
    19 unit uLandObjects;
    20 interface
    20 interface
    21 uses SDLh;
    21 uses SDLh;
    22 {$include options.inc}
    22 {$include options.inc}
    23 
    23 
    24 procedure AddObjects(InSurface, Surface: PSDL_Surface);
    24 procedure AddObjects();
    25 procedure LoadThemeConfig;
    25 procedure LoadThemeConfig;
    26 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
    26 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
    27 
    27 
    28 implementation
    28 implementation
    29 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom, uVisualGears, uFloat, GL, uSound;
    29 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom, uVisualGears, uFloat, GL, uSound;
    30 const MaxRects = 256;
    30 const MaxRects = 256;
    31       MAXOBJECTRECTS = 16;
    31       MAXOBJECTRECTS = 16;
    59     RectCount: Longword;
    59     RectCount: Longword;
    60     ThemeObjects: TThemeObjects;
    60     ThemeObjects: TThemeObjects;
    61     SprayObjects: TSprayObjects;
    61     SprayObjects: TSprayObjects;
    62 
    62 
    63 
    63 
    64 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
    64 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
    65 var p: PByteArray;
    65 var p: PByteArray;
    66     x, y: Longword;
    66     x, y: Longword;
    67     bpp: LongInt;
    67     bpp: LongInt;
    68     r: TSDL_Rect;
    68     r: TSDL_Rect;
    69 begin
    69 begin
    70 r.x:= cpX;
    70 r.x:= cpX;
    71 r.y:= cpY;
    71 r.y:= cpY;
    72 SDL_UpperBlit(Image, nil, Surface, @r);
       
    73 WriteToConsole('Generating collision info... ');
    72 WriteToConsole('Generating collision info... ');
    74 
    73 
    75 if SDL_MustLock(Image) then
    74 if SDL_MustLock(Image) then
    76    SDLTry(SDL_LockSurface(Image) >= 0, true);
    75    SDLTry(SDL_LockSurface(Image) >= 0, true);
    77 
    76 
    78 bpp:= Image^.format^.BytesPerPixel;
    77 bpp:= Image^.format^.BytesPerPixel;
    79 WriteToConsole('('+inttostr(bpp)+') ');
    78 TryDo(bpp = 4, 'Land object should be 32bit', true);
    80 p:= Image^.pixels;
    79 p:= Image^.pixels;
    81 case bpp of
    80 
    82      1: OutError('We don''t work with 8 bit surfaces', true);
    81 for y:= 0 to Pred(Image^.h) do
    83      2: for y:= 0 to Pred(Image^.h) do
    82 	begin
    84             begin
    83 	for x:= 0 to Pred(Image^.w) do
    85             for x:= 0 to Pred(Image^.w) do
    84 		//if LandPixels[cpY + y, cpX + x] = 0 then
    86                 if PWord(@(p^[x * 2]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
    85 			begin
    87             p:= @(p^[Image^.pitch]);
    86 			LandPixels[cpY + y, cpX + x]:= PLongword(@(p^[x * 4]))^;
    88             end;
    87 			if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
    89      3: for y:= 0 to Pred(Image^.h) do
    88 			end;
    90             begin
    89 	p:= @(p^[Image^.pitch]);
    91             for x:= 0 to Pred(Image^.w) do
    90 	end;
    92                 if  (p^[x * 3 + 0] <> 0)
    91 
    93                  or (p^[x * 3 + 1] <> 0)
       
    94                  or (p^[x * 3 + 2] <> 0) then Land[cpY + y, cpX + x]:= COLOR_LAND;
       
    95             p:= @(p^[Image^.pitch]);
       
    96             end;
       
    97      4: for y:= 0 to Pred(Image^.h) do
       
    98             begin
       
    99             for x:= 0 to Pred(Image^.w) do
       
   100                 if PLongword(@(p^[x * 4]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
       
   101             p:= @(p^[Image^.pitch]);
       
   102             end;
       
   103      end;
       
   104 if SDL_MustLock(Image) then
    92 if SDL_MustLock(Image) then
   105    SDL_UnlockSurface(Image);
    93    SDL_UnlockSurface(Image);
   106 WriteLnToConsole(msgOK)
    94 WriteLnToConsole(msgOK)
   107 end;
    95 end;
   108 
    96 
   255         end else
   243         end else
   256         Result:= false;
   244         Result:= false;
   257 CheckCanPlace:= Result
   245 CheckCanPlace:= Result
   258 end;
   246 end;
   259 
   247 
   260 function TryPut(var Obj: TThemeObject; Surface: PSDL_Surface): boolean; overload;
   248 function TryPut(var Obj: TThemeObject): boolean; overload;
   261 const MaxPointsIndex = 2047;
   249 const MaxPointsIndex = 2047;
   262 var x, y: Longword;
   250 var x, y: Longword;
   263     ar: array[0..MaxPointsIndex] of TPoint;
   251     ar: array[0..MaxPointsIndex] of TPoint;
   264     cnt, i: Longword;
   252     cnt, i: Longword;
   265     Result: boolean;
   253     Result: boolean;
   290      until x > 2047 - Width;
   278      until x > 2047 - Width;
   291      Result:= cnt <> 0;
   279      Result:= cnt <> 0;
   292      if Result then
   280      if Result then
   293         begin
   281         begin
   294         i:= getrandom(cnt);
   282         i:= getrandom(cnt);
   295         BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf, Surface);
   283         BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf);
   296         AddRect(ar[i].x, ar[i].y, Width, Height);
   284         AddRect(ar[i].x, ar[i].y, Width, Height);
   297         dec(Maxcnt)
   285         dec(Maxcnt)
   298         end else Maxcnt:= 0
   286         end else Maxcnt:= 0
   299      end;
   287      end;
   300 TryPut:= Result
   288 TryPut:= Result
   434     t:= getrandom(ThemeObjects.Count);
   422     t:= getrandom(ThemeObjects.Count);
   435     ii:= t;
   423     ii:= t;
   436     repeat
   424     repeat
   437       inc(ii);
   425       inc(ii);
   438       if ii = ThemeObjects.Count then ii:= 0;
   426       if ii = ThemeObjects.Count then ii:= 0;
   439       b:= TryPut(ThemeObjects.objs[ii], Surface)
   427       b:= TryPut(ThemeObjects.objs[ii])
   440     until b or (ii = t);
   428     until b or (ii = t);
   441     inc(i)
   429     inc(i)
   442 until (i > MaxCount) or not b;
   430 until (i > MaxCount) or not b;
   443 end;
   431 end;
   444 
   432 
   460     until b or (ii = t);
   448     until b or (ii = t);
   461     inc(i)
   449     inc(i)
   462 until (i > MaxCount) or not b;
   450 until (i > MaxCount) or not b;
   463 end;
   451 end;
   464 
   452 
   465 procedure AddObjects(InSurface, Surface: PSDL_Surface);
   453 procedure AddObjects();
   466 begin
   454 begin
   467 InitRects;
   455 {InitRects;
   468 AddGirder(256, Surface);
   456 AddGirder(256, Surface);
   469 AddGirder(512, Surface);
   457 AddGirder(512, Surface);
   470 AddGirder(768, Surface);
   458 AddGirder(768, Surface);
   471 AddGirder(1024, Surface);
   459 AddGirder(1024, Surface);
   472 AddGirder(1280, Surface);
   460 AddGirder(1280, Surface);
   474 AddGirder(1792, Surface);
   462 AddGirder(1792, Surface);
   475 AddThemeObjects(Surface, ThemeObjects, 8);
   463 AddThemeObjects(Surface, ThemeObjects, 8);
   476 AddProgress;
   464 AddProgress;
   477 SDL_UpperBlit(InSurface, nil, Surface, nil);
   465 SDL_UpperBlit(InSurface, nil, Surface, nil);
   478 AddSprayObjects(Surface, SprayObjects, 10);
   466 AddSprayObjects(Surface, SprayObjects, 10);
   479 FreeRects
   467 FreeRects}
   480 end;
   468 end;
   481 
   469 
   482 procedure LoadThemeConfig;
   470 procedure LoadThemeConfig;
   483 begin
   471 begin
   484 ReadThemeInfo(ThemeObjects, SprayObjects)
   472 ReadThemeInfo(ThemeObjects, SprayObjects)