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/uGears.pas
changeset 70 82d93eeecebe
parent 68 cbb93eb90304
child 74 42257fee61ae
equal deleted inserted replaced
69:d8a526934b9f 70:82d93eeecebe 
    72 procedure AddMiscGears;
 
    72 procedure AddMiscGears;
 
    73 procedure AssignHHCoords;
 
    73 procedure AssignHHCoords;
 
    74 
    74 
    75 var CurAmmoGear: PGear = nil;
 
    75 var CurAmmoGear: PGear = nil;
 
    76     GearsList: PGear = nil;
 
    76     GearsList: PGear = nil;
 
    77     
    77 
    78 implementation
 
    78 implementation
 
    79 uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand, uIO, uLandGraphics;
 
    79 uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand, uIO, uLandGraphics;
 
    80 var RopePoints: record
 
    80 var RopePoints: record
 
    81                 Count: Longword;
 
    81                 Count: Longword;
 
    82                 HookAngle: integer;
 
    82                 HookAngle: integer;
 
    91 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;
 
    91 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;
 
    92 procedure AmmoShove(Ammo: PGear; Power: integer); forward;
 
    92 procedure AmmoShove(Ammo: PGear; Power: integer); forward;
 
    93 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; forward;
 
    93 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; forward;
 
    94 procedure SpawnBoxOfSmth; forward;
 
    94 procedure SpawnBoxOfSmth; forward;
 
    95 procedure AfterAttack; forward;
 
    95 procedure AfterAttack; forward;
 
       
    96 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer); forward;
 
    96 
    97 
    97 {$INCLUDE GSHandlers.inc}
 
    98 {$INCLUDE GSHandlers.inc}
 
    98 {$INCLUDE HHHandlers.inc}
 
    99 {$INCLUDE HHHandlers.inc}
 
    99 
   100 
   100 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
 
   101 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
 
   143                 Result.Timer:= Timer
 
   144                 Result.Timer:= Timer
 
   144                 end;
 
   145                 end;
 
   145     gtHedgehog: begin
 
   146     gtHedgehog: begin
 
   146                 Result.Radius:= cHHRadius;
 
   147                 Result.Radius:= cHHRadius;
 
   147                 Result.Elasticity:= 0.002;
 
   148                 Result.Elasticity:= 0.002;
 
   148                 Result.Friction:= 0.9985;
 
   149                 Result.Friction:= 0.999;
 
   149                 Result.Angle:= cMaxAngle div 2;
 
   150                 Result.Angle:= cMaxAngle div 2;
 
   150                 end;
 
   151                 end;
 
   151 gtAmmo_Grenade: begin
 
   152 gtAmmo_Grenade: begin
 
   152                 Result.Radius:= 4;
 
   153                 Result.Radius:= 4;
 
   153                 end;
 
   154                 end;
 
   513       Dispose(t)
 
   514       Dispose(t)
 
   514       end;
 
   515       end;
 
   515 end;
 
   516 end;
 
   516 
   517 
   517 procedure AddMiscGears;
 
   518 procedure AddMiscGears;
 
   518 var i, x, y: integer;
 
   519 var i: integer;
 
   519 begin
 
   520 begin
 
   520 for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);
 
   521 for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);
 
   521 AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;
 
   522 AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;
 
   522 if (GameFlags and gfForts) = 0 then
 
   523 if (GameFlags and gfForts) = 0 then
 
   523    begin
 
       
   524    for i:= 0 to 3 do
 
   524    for i:= 0 to 3 do
 
   525        begin
 
   525        FindPlace(AddGear(0, 0, gtMine, 0), false, 0, 2048);
 
   526        GetHHPoint(x, y);
 
       
   527        AddGear(X, Y + 9, gtMine, 0);
 
       
   528        end;
 
       
   529    end;
 
       
   530 end;
 
   526 end;
 
   531 
   527 
   532 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);
 
   528 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);
 
   533 var Gear: PGear;
 
   529 var Gear: PGear;
 
   534     dmg: integer;
 
   530     dmg: integer;
 
   551                   gtMine,
 
   547                   gtMine,
 
   552                   gtCase: begin
 
   548                   gtCase: begin
 
   553                           if (Mask and EXPLNoDamage) = 0 then inc(Gear.Damage, dmg);
 
   549                           if (Mask and EXPLNoDamage) = 0 then inc(Gear.Damage, dmg);
 
   554                           if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear.Kind <> gtHedgehog) then
 
   550                           if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear.Kind <> gtHedgehog) then
 
   555                              begin
 
   551                              begin
 
   556                              Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X);
 
   552                              Gear.dX:= Gear.dX + dmg / 200 * Sign(Gear.X - X);
 
   557                              Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y);
 
   553                              Gear.dY:= Gear.dY + dmg / 200 * Sign(Gear.Y - Y);
 
   558                              Gear.Active:= true;
 
   554                              Gear.Active:= true;
 
   559                              FollowGear:= Gear
 
   555                              FollowGear:= Gear
 
   560                              end;
 
   556                              end;
 
   561                           end;
 
   557                           end;
 
   562                  gtGrave: begin
 
   558                  gtGrave: begin
 
   601       end
 
   597       end
 
   602 end;
 
   598 end;
 
   603 
   599 
   604 procedure AssignHHCoords;
 
   600 procedure AssignHHCoords;
 
   605 var Gear: PGear;
 
   601 var Gear: PGear;
 
   606     pX, pY: integer;
 
       
   607 begin
 
   602 begin
 
   608 Gear:= GearsList;
 
   603 Gear:= GearsList;
 
   609 while Gear <> nil do
 
   604 while Gear <> nil do
 
   610       begin
 
   605       begin
 
   611       if Gear.Kind = gtHedgehog then
 
   606       if Gear.Kind = gtHedgehog then
 
   612          begin
 
   607          FindPlace(Gear, false, 0, 2048);
 
   613          GetHHPoint(pX, pY);
 
       
   614          {$IFDEF DEBUGFILE}AddFileLog('HH at ('+inttostr(pX)+','+inttostr(pY)+')');{$ENDIF}
 
       
   615          Gear.X:= pX;
 
       
   616          Gear.Y:= pY
 
       
   617          end;
 
       
   618       Gear:= Gear.NextGear
 
   608       Gear:= Gear.NextGear
 
   619       end
 
   609       end
 
   620 end;
 
   610 end;
 
   621 
   611 
   622 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear;
 
   612 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear;
 
   668       t:= t.NextGear
 
   658       t:= t.NextGear
 
   669       end;
 
   659       end;
 
   670 end;
 
   660 end;
 
   671 
   661 
   672 procedure SpawnBoxOfSmth;
 
   662 procedure SpawnBoxOfSmth;
 
   673 var i, x, y, k: integer;
 
   663 begin
 
   674     b: boolean;
 
   664 if (CountGears(gtCase) > 2) or (getrandom(3) <> 0) then exit;
 
   675 begin
 
   665 FollowGear:= AddGear(0, 0, gtCase, 0);
 
   676 if (CountGears(gtCase) > 1) or (getrandom(3) <> 0) then exit;
 
   666 FollowGear.Health:= 25;
 
   677 k:= 7;
 
   667 FollowGear.Pos:= posCaseHealth;
 
       
   668 FindPlace(FollowGear, true, 0, 2048)
 
       
   669 end;
 
       
   670 
       
   671 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer);
 
       
   672 
       
   673     function CountNonZeroz(x, y, r: integer): integer;
 
       
   674     var i: integer;
 
       
   675     begin
 
       
   676     Result:= 0;
 
       
   677     if (y and $FFFFFC00) <> 0 then exit;
 
       
   678     for i:= max(x - r, 0) to min(x + r, 2043) do
 
       
   679         if Land[y, i] <> 0 then inc(Result)
 
       
   680     end;
 
       
   681 
       
   682 var fx, x: integer;
 
       
   683     y, sy: integer;
 
       
   684     ar: array[0..512] of TPoint;
 
       
   685     cnt, delta: Longword;
 
       
   686 begin
 
       
   687 fx:= Left + integer(GetRandom(Right - Left));
 
       
   688 x:= fx;
 
       
   689 delta:= 130;
 
   678 repeat
 
   690 repeat
 
   679   x:= getrandom(2000) + 24;
 
   691   repeat
 
   680   b:= false;
 
   692      inc(x, Gear.Radius);
 
   681   y:= -1;
 
   693      if x > Right then x:= Left + (x mod (Right - left));
 
   682   while (y < 1023) and not b do
 
   694      cnt:= 0;
 
       
   695      y:= -Gear.Radius * 2;
 
       
   696      while y < 1023 do
 
   683         begin
 
   697         begin
 
   684         inc(y);
 
   698         repeat
 
   685         i:= x - 13;
 
   699           inc(y, 2);
 
   686         while (i <= x + 13) and not b do // 13 is gtCase Radius-1
 
   700         until (y > 1023) or (CountNonZeroz(x, y, Gear.Radius - 1) = 0);
 
   687               begin
 
   701         sy:= y;
 
   688               if Land[y, i] <> 0 then
 
   702         repeat
 
   689                  begin
 
   703           inc(y);
 
   690                  b:= true;
 
   704         until (y > 1023) or (CountNonZeroz(x, y, Gear.Radius - 1) <> 0);
 
   691                  end;
 
   705         if (y - sy > Gear.Radius * 2)
 
   692               inc(i)
 
   706         and (y < 1023)
 
   693               end;
 
   707         and (CheckGearsNear(x, y - Gear.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then
 
       
   708            begin
 
       
   709            ar[cnt].X:= x;
 
       
   710            if withFall then ar[cnt].Y:= sy + Gear.Radius
 
       
   711                        else ar[cnt].Y:= y - Gear.Radius;
 
       
   712            inc(cnt)
 
       
   713            end;
 
       
   714         inc(y, 80)
 
   694         end;
 
   715         end;
 
   695   if b then
 
   716      if cnt > 0 then
 
   696      b:= CheckGearsNear(x, y, [gtMine, gtHedgehog, gtCase], 70, 70) = nil;
 
   717         with ar[GetRandom(cnt)] do
 
   697   dec(k)
 
   718           begin
 
   698 until (k = 0) or b;
 
   719           Gear.X:= x;
 
   699 if b then
 
   720           Gear.Y:= y;
 
   700    begin
 
   721          {$IFDEF DEBUGFILE}
 
   701    FollowGear:= AddGear(x, -30, gtCase, 0);
 
   722          AddFileLog('Assigned Gear ' + inttostr(integer(Gear)) +
 
   702    FollowGear.Health:= 25;
 
   723                     ' coordinates (' + inttostr(x) +
 
   703    FollowGear.Pos:= posCaseHealth
 
   724                     ',' + inttostr(y) + ')');
 
   704    end;
 
   725          {$ENDIF}
 
       
   726           exit
 
       
   727           end
 
       
   728   until (x - Gear.Radius < fx) and (x + Gear.Radius > fx);
 
       
   729 dec(Delta, 20)
 
       
   730 until (Delta < 70);
 
       
   731 OutError('Couldn''t find place for Gear ' + inttostr(integer(Gear)), false);
 
       
   732 DeleteGear(Gear)
 
   705 end;
 
   733 end;
 
   706 
   734 
   707 initialization
 
   735 initialization
 
   708 
   736 
   709 finalization
 
   737 finalization
hedgewars