hedgewars/uGears.pas
changeset 371 731ad6d27bd1
parent 370 c75410fe3133
child 386 21eeb5ac0486
equal deleted inserted replaced
370:c75410fe3133 371:731ad6d27bd1
    33              dX: hwFloat;
    33              dX: hwFloat;
    34              dY: hwFloat;
    34              dY: hwFloat;
    35              Kind: TGearType;
    35              Kind: TGearType;
    36              Pos: Longword;
    36              Pos: Longword;
    37              doStep: TGearStepProcedure;
    37              doStep: TGearStepProcedure;
    38              Radius: integer;
    38              Radius: LongInt;
    39              Angle, Power : Longword;
    39              Angle, Power : Longword;
    40              DirAngle: hwFloat;
    40              DirAngle: hwFloat;
    41              Timer : LongWord;
    41              Timer : LongWord;
    42              Elasticity: hwFloat;
    42              Elasticity: hwFloat;
    43              Friction  : hwFloat;
    43              Friction  : hwFloat;
    44              Message : Longword;
    44              Message : Longword;
    45              Hedgehog: pointer;
    45              Hedgehog: pointer;
    46              Health, Damage: integer;
    46              Health, Damage: LongInt;
    47              CollIndex: Longword;
    47              CollIndex: Longword;
    48              Tag: integer;
    48              Tag: LongInt;
    49              Surf: PSDL_Surface;
    49              Surf: PSDL_Surface;
    50              Z: Longword;
    50              Z: Longword;
    51              end;
    51              end;
    52 
    52 
    53 function  AddGear(X, Y: integer; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
    53 function  AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
    54 procedure ProcessGears;
    54 procedure ProcessGears;
    55 procedure SetAllToActive;
    55 procedure SetAllToActive;
    56 procedure SetAllHHToActive;
    56 procedure SetAllHHToActive;
    57 procedure DrawGears(Surface: PSDL_Surface);
    57 procedure DrawGears(Surface: PSDL_Surface);
    58 procedure FreeGearsList;
    58 procedure FreeGearsList;
    69 implementation
    69 implementation
    70 uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions,
    70 uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions,
    71      uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos;
    71      uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos;
    72 var RopePoints: record
    72 var RopePoints: record
    73                 Count: Longword;
    73                 Count: Longword;
    74                 HookAngle: integer;
    74                 HookAngle: LongInt;
    75                 ar: array[0..300] of record
    75                 ar: array[0..300] of record
    76                                   X, Y: hwFloat;
    76                                   X, Y: hwFloat;
    77                                   dLen: hwFloat;
    77                                   dLen: hwFloat;
    78                                   b: boolean;
    78                                   b: boolean;
    79                                   end;
    79                                   end;
    80                  end;
    80                  end;
    81     StepDamage: Longword = 0;
    81     StepDamage: Longword = 0;
    82 
    82 
    83 procedure DeleteGear(Gear: PGear); forward;
    83 procedure DeleteGear(Gear: PGear); forward;
    84 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;
    84 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); forward;
    85 procedure AmmoShove(Ammo: PGear; Damage, Power: integer); forward;
    85 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
    86 procedure AmmoFlameWork(Ammo: PGear); forward;
    86 procedure AmmoFlameWork(Ammo: PGear); forward;
    87 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; forward;
    87 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; forward;
    88 procedure SpawnBoxOfSmth; forward;
    88 procedure SpawnBoxOfSmth; forward;
    89 procedure AfterAttack; forward;
    89 procedure AfterAttack; forward;
    90 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer); forward;
    90 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt); forward;
    91 procedure HedgehogStep(Gear: PGear); forward;
    91 procedure HedgehogStep(Gear: PGear); forward;
    92 procedure HedgehogChAngle(Gear: PGear); forward;
    92 procedure HedgehogChAngle(Gear: PGear); forward;
    93 
    93 
    94 {$INCLUDE GSHandlers.inc}
    94 {$INCLUDE GSHandlers.inc}
    95 {$INCLUDE HHHandlers.inc}
    95 {$INCLUDE HHHandlers.inc}
   153    GearsList:= Gear^.NextGear;
   153    GearsList:= Gear^.NextGear;
   154    if GearsList <> nil then GearsList^.PrevGear:= nil
   154    if GearsList <> nil then GearsList^.PrevGear:= nil
   155    end;
   155    end;
   156 end;
   156 end;
   157 
   157 
   158 function AddGear(X, Y: integer; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
   158 function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
   159 const Counter: Longword = 0;
   159 const Counter: Longword = 0;
   160 var Result: PGear;
   160 var Result: PGear;
   161 begin
   161 begin
   162 inc(Counter);
   162 inc(Counter);
   163 {$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+'), d('+floattostr(dX)+','+floattostr(dY)+')');{$ENDIF}
   163 {$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+'), d('+floattostr(dX)+','+floattostr(dY)+')');{$ENDIF}
   335       Gear:= Gear^.NextGear
   335       Gear:= Gear^.NextGear
   336       end;
   336       end;
   337 end;
   337 end;
   338 
   338 
   339 procedure ProcessGears;
   339 procedure ProcessGears;
   340 const delay: integer = cInactDelay;
   340 const delay: LongInt = cInactDelay;
   341       step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay;
   341       step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay;
   342 var Gear, t: PGear;
   342 var Gear, t: PGear;
   343 {$IFDEF COUNTTICKS}
   343 {$IFDEF COUNTTICKS}
   344     tickcntA, tickcntB: LongWord;
   344     tickcntA, tickcntB: LongWord;
   345 const cntSecTicks: LongWord = 0;
   345 const cntSecTicks: LongWord = 0;
   446       t:= t^.NextGear
   446       t:= t^.NextGear
   447       end
   447       end
   448 end;
   448 end;
   449 
   449 
   450 procedure DrawHH(Gear: PGear; Surface: PSDL_Surface);
   450 procedure DrawHH(Gear: PGear; Surface: PSDL_Surface);
   451 var t: integer;
   451 var t: LongInt;
   452 begin
   452 begin
   453 DrawHedgehog(hwRound(Gear^.X) - 14 + WorldDx, hwRound(Gear^.Y) - 18 + WorldDy,
   453 DrawHedgehog(hwRound(Gear^.X) - 14 + WorldDx, hwRound(Gear^.Y) - 18 + WorldDy,
   454              hwSign(Gear^.dX), 0,
   454              hwSign(Gear^.dX), 0,
   455              PHedgehog(Gear^.Hedgehog)^.visStepPos div 2,
   455              PHedgehog(Gear^.Hedgehog)^.visStepPos div 2,
   456              Surface);
   456              Surface);
   475               DrawGear(sQuestion, hwRound(Gear^.X) - 10 + WorldDx, hwRound(Gear^.Y) - cHHRadius - 34 + WorldDy, Surface)
   475               DrawGear(sQuestion, hwRound(Gear^.X) - 10 + WorldDx, hwRound(Gear^.Y) - cHHRadius - 34 + WorldDy, Surface)
   476               else
   476               else
   477               if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then
   477               if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then
   478                  DrawSurfSprite(Round(hwRound(Gear^.X) + hwSign(Gear^.dX) * Sin(Gear^.Angle*pi/cMaxAngle)*60) + WorldDx - 11,
   478                  DrawSurfSprite(Round(hwRound(Gear^.X) + hwSign(Gear^.dX) * Sin(Gear^.Angle*pi/cMaxAngle)*60) + WorldDx - 11,
   479                            Round(hwRound(Gear^.Y) - Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy - 12,
   479                            Round(hwRound(Gear^.Y) - Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy - 12,
   480                            24, (18 + hwSign(Gear^.dX) * integer(((Gear^.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18,
   480                            24, (18 + hwSign(Gear^.dX) * LongInt(((Gear^.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18,
   481                            Team^.CrosshairSurf, Surface);
   481                            Team^.CrosshairSurf, Surface);
   482         end;
   482         end;
   483 end;
   483 end;
   484 
   484 
   485 procedure DrawGears(Surface: PSDL_Surface);
   485 procedure DrawGears(Surface: PSDL_Surface);
   486 var Gear: PGear;
   486 var Gear: PGear;
   487     i: Longword;
   487     i: Longword;
   488     roplen: integer;
   488     roplen: LongInt;
   489 
   489 
   490     procedure DrawRopeLine(X1, Y1, X2, Y2: integer);
   490     procedure DrawRopeLine(X1, Y1, X2, Y2: LongInt);
   491     var  eX, eY, dX, dY: integer;
   491     var  eX, eY, dX, dY: LongInt;
   492          i, sX, sY, x, y, d: integer;
   492          i, sX, sY, x, y, d: LongInt;
   493          b: boolean;
   493          b: boolean;
   494     begin
   494     begin
   495     if (X1 = X2) and (Y1 = Y2) then
   495     if (X1 = X2) and (Y1 = Y2) then
   496        begin
   496        begin
   497        OutError('WARNING: zero length rope line!', false);
   497        OutError('WARNING: zero length rope line!', false);
   616       Dispose(t)
   616       Dispose(t)
   617       end;
   617       end;
   618 end;
   618 end;
   619 
   619 
   620 procedure AddMiscGears;
   620 procedure AddMiscGears;
   621 var i: integer;
   621 var i: LongInt;
   622 begin
   622 begin
   623 AddGear(0, 0, gtATStartGame, 0, 0, 0, 2000);
   623 AddGear(0, 0, gtATStartGame, 0, 0, 0, 2000);
   624 if (GameFlags and gfForts) = 0 then
   624 if (GameFlags and gfForts) = 0 then
   625    for i:= 0 to 3 do
   625    for i:= 0 to 3 do
   626        FindPlace(AddGear(0, 0, gtMine, 0, 0, 0, 0), false, 0, 2048);
   626        FindPlace(AddGear(0, 0, gtMine, 0, 0, 0, 0), false, 0, 2048);
   627 end;
   627 end;
   628 
   628 
   629 procedure AddClouds;
   629 procedure AddClouds;
   630 var i: integer;
   630 var i: LongInt;
   631     dx, dy: hwFloat;
   631     dx, dy: hwFloat;
   632 begin
   632 begin
   633 for i:= 0 to cCloudsNumber do
   633 for i:= 0 to cCloudsNumber do
   634     begin
   634     begin
   635     dx.isNegative:= random(2) = 1;
   635     dx.isNegative:= random(2) = 1;
   639     AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -140,
   639     AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -140,
   640              gtCloud, random(4), dx, dy, 0)
   640              gtCloud, random(4), dx, dy, 0)
   641     end
   641     end
   642 end;
   642 end;
   643 
   643 
   644 procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);
   644 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord);
   645 var Gear: PGear;
   645 var Gear: PGear;
   646     dmg: integer;
   646     dmg: LongInt;
   647 begin
   647 begin
   648 TargetPoint.X:= NoPointX;
   648 TargetPoint.X:= NoPointX;
   649 {$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}
   649 {$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}
   650 if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius);
   650 if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius);
   651 if Radius = 50 then AddGear(X, Y, gtExplosion, 0, 0, 0, 0);
   651 if Radius = 50 then AddGear(X, Y, gtExplosion, 0, 0, 0, 0);
   682       Gear:= Gear^.NextGear
   682       Gear:= Gear^.NextGear
   683       end;
   683       end;
   684 //uAIMisc.AwareOfExplosion(0, 0, 0)
   684 //uAIMisc.AwareOfExplosion(0, 0, 0)
   685 end;
   685 end;
   686 
   686 
   687 procedure AmmoShove(Ammo: PGear; Damage, Power: integer);
   687 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt);
   688 var t: PGearArray;
   688 var t: PGearArray;
   689     i: integer;
   689     i: LongInt;
   690     hh: PHedgehog;
   690     hh: PHedgehog;
   691 begin
   691 begin
   692 t:= CheckGearsCollision(Ammo);
   692 t:= CheckGearsCollision(Ammo);
   693 i:= t^.Count;
   693 i:= t^.Count;
   694 hh:= Ammo^.Hedgehog;
   694 hh:= Ammo^.Hedgehog;
   713 SetAllToActive
   713 SetAllToActive
   714 end;
   714 end;
   715 
   715 
   716 procedure AssignHHCoords;
   716 procedure AssignHHCoords;
   717 var Team: PTeam;
   717 var Team: PTeam;
   718     i, t: integer;
   718     i, t: LongInt;
   719 begin
   719 begin
   720 Team:= TeamsList;
   720 Team:= TeamsList;
   721 t:= 0;
   721 t:= 0;
   722 while Team <> nil do
   722 while Team <> nil do
   723       begin
   723       begin
   729       inc(t, 1024);
   729       inc(t, 1024);
   730       Team:= Team^.Next
   730       Team:= Team^.Next
   731       end
   731       end
   732 end;
   732 end;
   733 
   733 
   734 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear;
   734 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
   735 var t: PGear;
   735 var t: PGear;
   736 begin
   736 begin
   737 t:= GearsList;
   737 t:= GearsList;
   738 rX:= sqr(rX);
   738 rX:= sqr(rX);
   739 rY:= sqr(rY);
   739 rY:= sqr(rY);
   765             end;
   765             end;
   766       t:= t^.NextGear
   766       t:= t^.NextGear
   767       end;
   767       end;
   768 end;
   768 end;
   769 
   769 
   770 function CheckGearsNear(mX, mY: integer; Kind: TGearsType; rX, rY: integer): PGear;
   770 function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
   771 var t: PGear;
   771 var t: PGear;
   772 begin
   772 begin
   773 t:= GearsList;
   773 t:= GearsList;
   774 rX:= sqr(rX);
   774 rX:= sqr(rX);
   775 rY:= sqr(rY);
   775 rY:= sqr(rY);
   812         end;
   812         end;
   813      end;
   813      end;
   814 FindPlace(FollowGear, true, 0, 2048)
   814 FindPlace(FollowGear, true, 0, 2048)
   815 end;
   815 end;
   816 
   816 
   817 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer);
   817 procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt);
   818 
   818 
   819     function CountNonZeroz(x, y, r: integer): integer;
   819     function CountNonZeroz(x, y, r: LongInt): LongInt;
   820     var i: integer;
   820     var i: LongInt;
   821         Result: integer;
   821         Result: LongInt;
   822     begin
   822     begin
   823     Result:= 0;
   823     Result:= 0;
   824     if (y and $FFFFFC00) <> 0 then exit;
   824     if (y and $FFFFFC00) <> 0 then exit;
   825     for i:= max(x - r, 0) to min(x + r, 2043) do
   825     for i:= max(x - r, 0) to min(x + r, 2043) do
   826         if Land[y, i] <> 0 then inc(Result);
   826         if Land[y, i] <> 0 then inc(Result);
   827     CountNonZeroz:= Result
   827     CountNonZeroz:= Result
   828     end;
   828     end;
   829 
   829 
   830 var fx, x: integer;
   830 var fx, x: LongInt;
   831     y, sy: integer;
   831     y, sy: LongInt;
   832     ar: array[0..512] of TPoint;
   832     ar: array[0..512] of TPoint;
   833     cnt, delta: Longword;
   833     cnt, delta: Longword;
   834 begin
   834 begin
   835 fx:= Left + integer(GetRandom(Right - Left));
   835 fx:= Left + LongInt(GetRandom(Right - Left));
   836 x:= fx;
   836 x:= fx;
   837 delta:= 130;
   837 delta:= 130;
   838 repeat
   838 repeat
   839   repeat
   839   repeat
   840      inc(x, Gear^.Radius);
   840      inc(x, Gear^.Radius);