Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLandObjects.pas
changeset 1183 540cea859395
parent 1182 e2e13aa055c1
child 1184 852f8872da1a
equal deleted inserted replaced
1182:e2e13aa055c1 1183:540cea859395 
    21 uses SDLh;
 
    21 uses SDLh;
 
    22 {$include options.inc}
 
    22 {$include options.inc}
 
    23 
    23 
    24 procedure AddObjects();
 
    24 procedure AddObjects();
 
    25 procedure LoadThemeConfig;
 
    25 procedure LoadThemeConfig;
 
    26 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
 
    26 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: 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: PSDL_Surface);
 
    64 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);
 
    65 var p: PLongwordArray;
 
    65 var p: PLongwordArray;
 
    66     x, y: Longword;
 
    66     x, y: Longword;
 
    67     bpp: LongInt;
 
    67     bpp: LongInt;
 
    68     r: TSDL_Rect;
 
    68 begin
 
    69 begin
 
       
    70 r.x:= cpX;
 
       
    71 r.y:= cpY;
 
       
    72 WriteToConsole('Generating collision info... ');
 
    69 WriteToConsole('Generating collision info... ');
 
    73 
    70 
    74 if SDL_MustLock(Image) then
 
    71 if SDL_MustLock(Image) then
 
    75    SDLTry(SDL_LockSurface(Image) >= 0, true);
 
    72    SDLTry(SDL_LockSurface(Image) >= 0, true);
 
    76 
    73 
    77 bpp:= Image^.format^.BytesPerPixel;
 
    74 bpp:= Image^.format^.BytesPerPixel;
 
    78 TryDo(bpp = 4, 'Land object should be 32bit', true);
 
    75 TryDo(bpp = 4, 'Land object should be 32bit', true);
 
       
    76 
       
    77 if Width = 0 then Width:= Image^.w;
 
    79 
    78 
    80 p:= Image^.pixels;
 
    79 p:= Image^.pixels;
 
    81 for y:= 0 to Pred(Image^.h) do
 
    80 for y:= 0 to Pred(Image^.h) do
 
    82 	begin
 
    81 	begin
 
    83 	for x:= 0 to Pred(Image^.w) do
 
    82 	for x:= 0 to Pred(Width) do
 
    84 		if LandPixels[cpY + y, cpX + x] = 0 then
 
    83 		if LandPixels[cpY + y, cpX + x] = 0 then
 
    85 			begin
 
    84 			begin
 
    86 			LandPixels[cpY + y, cpX + x]:= p^[x];
 
    85 			LandPixels[cpY + y, cpX + x]:= p^[x];
 
    87 			if (p^[x] and $FF000000) <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
 
    86 			if (p^[x] and $FF000000) <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
 
    88 			end;
 
    87 			end;
 
   132    inc(i)
 
   131    inc(i)
 
   133    until (i = RectCount) or (Result);
 
   132    until (i = RectCount) or (Result);
 
   134 CheckIntersect:= Result
 
   133 CheckIntersect:= Result
 
   135 end;
 
   134 end;
 
   136 
   135 
   137 function AddGirder(gX: LongInt; Surface: PSDL_Surface): boolean;
 
   136 function AddGirder(gX: LongInt): boolean;
 
   138 var tmpsurf: PSDL_Surface;
 
   137 var tmpsurf: PSDL_Surface;
 
   139     x1, x2, y, k, i: LongInt;
 
   138     x1, x2, y, k, i: LongInt;
 
   140     r, rr: TSDL_Rect;
 
   139     rr: TSDL_Rect;
 
   141     Result: boolean;
 
   140     Result: boolean;
 
   142 
   141 
   143     function CountNonZeroz(x, y: LongInt): Longword;
 
   142 	function CountNonZeroz(x, y: LongInt): Longword;
 
   144     var i: LongInt;
 
   143 	var i: LongInt;
 
   145         Result: Longword;
 
   144 		Result: Longword;
 
   146     begin
 
   145 	begin
 
   147     Result:= 0;
 
   146 	Result:= 0;
 
   148     for i:= y to y + 15 do
 
   147 	for i:= y to y + 15 do
 
   149         if Land[i, x] <> 0 then inc(Result);
 
   148 		if Land[i, x] <> 0 then inc(Result);
 
   150     CountNonZeroz:= Result
 
   149 	CountNonZeroz:= Result
 
   151     end;
 
   150 	end;
 
   152 
   151 
   153 begin
 
   152 begin
 
   154 y:= 150;
 
   153 y:= 150;
 
   155 repeat
 
   154 repeat
 
   156   inc(y, 24);
 
   155 	inc(y, 24);
 
   157   x1:= gX;
 
   156 	x1:= gX;
 
   158   x2:= gX;
 
   157 	x2:= gX;
 
   159   while (x1 > 100) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);
 
   158 	
   160   i:= x1 - 12;
 
   159 	while (x1 > 100) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);
 
   161   repeat
 
   160 
   162     dec(x1, 2);
 
   161 	i:= x1 - 12;
 
   163     k:= CountNonZeroz(x1, y)
 
   162 	repeat
 
   164   until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
 
   163 		dec(x1, 2);
 
   165   inc(x1, 2);
 
   164 		k:= CountNonZeroz(x1, y)
 
   166   if k = 16 then
 
   165 	until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
 
   167      begin
 
   166 	
   168      while (x2 < 1900) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);
 
   167 	inc(x1, 2);
 
   169      i:= x2 + 12;
 
   168 	if k = 16 then
 
   170      repeat
 
   169 		begin
 
   171        inc(x2, 2);
 
   170 		while (x2 < 1900) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);
 
   172        k:= CountNonZeroz(x2, y)
 
   171 		i:= x2 + 12;
 
   173      until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
 
   172 		repeat
 
   174      if (x2 < 1900) and (k = 16) and (x2 - x1 > 250)
 
   173 		inc(x2, 2);
 
   175         and not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144) then break;
 
   174 		k:= CountNonZeroz(x2, y)
 
   176      end;
 
   175 		until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
 
       
   176 		if (x2 < 1900) and (k = 16) and (x2 - x1 > 250)
 
       
   177 			and not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144) then break;
 
       
   178 		end;
 
   177 x1:= 0;
 
   179 x1:= 0;
 
   178 until y > 900;
 
   180 until y > 900;
 
       
   181 
   179 if x1 > 0 then
 
   182 if x1 > 0 then
 
   180    begin
 
   183 	begin
 
   181    Result:= true;
 
   184 	Result:= true;
 
   182    tmpsurf:= LoadImage(Pathz[ptGraphics] + '/Girder', false, true, true);
 
   185 	tmpsurf:= LoadImage(Pathz[ptGraphics] + '/Girder', false, true, true);
 
   183    rr.x:= x1;
 
   186 	rr.x:= x1;
 
   184    rr.y:= y;
 
   187 	while rr.x < x2 do
 
   185    while rr.x + 100 < x2 do
 
   188 		begin
 
   186          begin
 
   189 		BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
 
   187          SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
 
   190 		inc(rr.x, tmpsurf^.w);
 
   188          inc(rr.x, 100);
 
   191 		end;
 
   189          end;
 
   192 	SDL_FreeSurface(tmpsurf);
 
   190    r.x:= 0;
 
   193 	
   191    r.y:= 0;
 
   194 	AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80);
 
   192    r.w:= x2 - rr.x;
 
   195 	end else Result:= false;
 
   193    r.h:= 16;
 
   196 
   194    SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
       
   195    SDL_FreeSurface(tmpsurf);
 
       
   196    AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80);
 
       
   197    for k:= y to y + 15 do
 
       
   198        for i:= x1 to x2 do Land[k, i]:= $FFFFFF
 
       
   199    end else Result:= false;
 
       
   200 AddGirder:= Result
 
   197 AddGirder:= Result
 
   201 end;
 
   198 end;
 
   202 
   199 
   203 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;
 
   200 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;
 
   204 var i: Longword;
 
   201 var i: Longword;
 
   278      until x > 2047 - Width;
 
   275      until x > 2047 - Width;
 
   279      Result:= cnt <> 0;
 
   276      Result:= cnt <> 0;
 
   280      if Result then
 
   277      if Result then
 
   281         begin
 
   278         begin
 
   282         i:= getrandom(cnt);
 
   279         i:= getrandom(cnt);
 
   283         BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf);
 
   280         BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
 
   284         AddRect(ar[i].x, ar[i].y, Width, Height);
 
   281         AddRect(ar[i].x, ar[i].y, Width, Height);
 
   285         dec(Maxcnt)
 
   282         dec(Maxcnt)
 
   286         end else Maxcnt:= 0
 
   283         end else Maxcnt:= 0
 
   287      end;
 
   284      end;
 
   288 TryPut:= Result
 
   285 TryPut:= Result
 
   450 until (i > MaxCount) or not b;
 
   447 until (i > MaxCount) or not b;
 
   451 end;
 
   448 end;
 
   452 
   449 
   453 procedure AddObjects();
 
   450 procedure AddObjects();
 
   454 begin
 
   451 begin
 
   455 {InitRects;
 
   452 InitRects;
 
   456 AddGirder(256, Surface);
 
   453 AddGirder(256);
 
   457 AddGirder(512, Surface);
 
   454 AddGirder(512);
 
   458 AddGirder(768, Surface);
 
   455 AddGirder(768);
 
   459 AddGirder(1024, Surface);
 
   456 AddGirder(1024);
 
   460 AddGirder(1280, Surface);
 
   457 AddGirder(1280);
 
   461 AddGirder(1536, Surface);
 
   458 AddGirder(1536);
 
   462 AddGirder(1792, Surface);
 
   459 AddGirder(1792);
 
   463 AddThemeObjects(Surface, ThemeObjects, 8);
 
   460 {AddThemeObjects(Surface, ThemeObjects, 8);
 
   464 AddProgress;
 
   461 AddProgress;
 
   465 SDL_UpperBlit(InSurface, nil, Surface, nil);
 
   462 SDL_UpperBlit(InSurface, nil, Surface, nil);
 
   466 AddSprayObjects(Surface, SprayObjects, 10);
 
   463 AddSprayObjects(Surface, SprayObjects, 10);
 
   467 FreeRects}
 
   464 FreeRects}
 
   468 end;
 
   465 end;
hedgewars