hedgewars/uGearsUtils.pas
branchwebgl
changeset 8026 4a4f21070479
parent 8007 b07ce9dfc6bb
child 8330 aaefa587e277
equal deleted inserted replaced
8023:7de85783b823 8026:4a4f21070479
   555 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
   555 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
   556 var x: LongInt;
   556 var x: LongInt;
   557     y, sy: LongInt;
   557     y, sy: LongInt;
   558     ar: array[0..1023] of TPoint;
   558     ar: array[0..1023] of TPoint;
   559     ar2: array[0..2047] of TPoint;
   559     ar2: array[0..2047] of TPoint;
       
   560     temp: TPoint;
   560     cnt, cnt2: Longword;
   561     cnt, cnt2: Longword;
   561     delta: LongInt;
   562     delta: LongInt;
   562     ignoreNearObjects, ignoreOverlap, tryAgain: boolean;
   563     ignoreNearObjects, ignoreOverlap, tryAgain: boolean;
   563 begin
   564 begin
   564 ignoreNearObjects:= false; // try not skipping proximity at first
   565 ignoreNearObjects:= false; // try not skipping proximity at first
   577             while y < cWaterLine do
   578             while y < cWaterLine do
   578                 begin
   579                 begin
   579                 repeat
   580                 repeat
   580                     inc(y, 2);
   581                     inc(y, 2);
   581                 until (y >= cWaterLine) or
   582                 until (y >= cWaterLine) or
   582                         (not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or 
   583                         ((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or 
   583                         (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) = 0));
   584                         (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) = 0));
   584 
   585 
   585                 sy:= y;
   586                 sy:= y;
   586 
   587 
   587                 repeat
   588                 repeat
   588                     inc(y);
   589                     inc(y);
   589                 until (y >= cWaterLine) or
   590                 until (y >= cWaterLine) or
   590                         (not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or 
   591                         ((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or 
   591                         (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) <> 0)); 
   592                         (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) <> 0)); 
   592 
   593 
   593                 if (y - sy > Gear^.Radius * 2)
   594                 if (y - sy > Gear^.Radius * 2)
   594                     and (((Gear^.Kind = gtExplosives)
   595                     and (((Gear^.Kind = gtExplosives)
   595                     and (y < cWaterLine)
   596                     and (y < cWaterLine)
   611 
   612 
   612                 inc(y, 10)
   613                 inc(y, 10)
   613                 end;
   614                 end;
   614 
   615 
   615             if cnt > 0 then
   616             if cnt > 0 then
   616                 with ar[GetRandom(cnt)] do
   617 	    begin
       
   618 	       temp := ar[GetRandom(cnt)];
       
   619                with temp do
   617                     begin
   620                     begin
   618                     ar2[cnt2].x:= x;
   621                     ar2[cnt2].x:= x;
   619                     ar2[cnt2].y:= y;
   622                     ar2[cnt2].y:= y;
   620                     inc(cnt2)
   623                     inc(cnt2)
   621                     end
   624 		    end
       
   625 	       end
   622         until (x + Delta > Right);
   626         until (x + Delta > Right);
   623 
   627 
   624         dec(Delta, 60)
   628         dec(Delta, 60)
   625     until (cnt2 > 0) or (Delta < 70);
   629     until (cnt2 > 0) or (Delta < 70);
   626     // if either of these has not been tried, do another pass
   630     // if either of these has not been tried, do another pass
   630     if ignoreNearObjects then ignoreOverlap:= true;
   634     if ignoreNearObjects then ignoreOverlap:= true;
   631     ignoreNearObjects:= true;
   635     ignoreNearObjects:= true;
   632     end;
   636     end;
   633 
   637 
   634 if cnt2 > 0 then
   638 if cnt2 > 0 then
   635     with ar2[GetRandom(cnt2)] do
   639     begin
       
   640     temp := ar2[GetRandom(cnt2)];
       
   641     with temp do
   636         begin
   642         begin
   637         Gear^.X:= int2hwFloat(x);
   643         Gear^.X:= int2hwFloat(x);
   638         Gear^.Y:= int2hwFloat(y);
   644         Gear^.Y:= int2hwFloat(y);
   639         AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
   645         AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
   640         end
   646         end
       
   647     end
   641     else
   648     else
   642     begin
   649     begin
   643     OutError('Can''t find place for Gear', false);
   650     OutError('Can''t find place for Gear', false);
   644     if Gear^.Kind = gtHedgehog then
   651     if Gear^.Kind = gtHedgehog then
   645         Gear^.Hedgehog^.Effects[heResurrectable] := 0;
   652         Gear^.Hedgehog^.Effects[heResurrectable] := 0;