allow gear specific data (with gear type specific type). applied to cake
authorsheepluva
Wed, 25 Mar 2015 20:30:52 +0100
changeset 10874 059a6492176e
parent 10873 84c00d1127d6
child 10875 67b92a09cded
allow gear specific data (with gear type specific type). applied to cake
hedgewars/uGearsHandlersMess.pas
hedgewars/uGearsList.pas
hedgewars/uTypes.pas
--- a/hedgewars/uGearsHandlersMess.pas	Tue Mar 24 21:18:05 2015 +0100
+++ b/hedgewars/uGearsHandlersMess.pas	Wed Mar 25 20:30:52 2015 +0100
@@ -3140,13 +3140,6 @@
 
 ////////////////////////////////////////////////////////////////////////////////
 
-const cakeh =   27;
-var
-    CakePoints: array[0..Pred(cakeh)] of record
-        x, y: hwFloat;
-    end;
-    CakeI: Longword;
-
 procedure doStepCakeExpl(Gear: PGear);
 begin
     AllInactive := false;
@@ -3213,6 +3206,7 @@
 procedure doStepCakeWork(Gear: PGear);
 var
     tdx, tdy: hwFloat;
+    cakeData: PCakeData;
 begin
     AllInactive := false;
 
@@ -3237,18 +3231,23 @@
 
     if Gear^.Tag = 0 then
         begin
-        CakeI := (CakeI + 1) mod cakeh;
-        tdx := CakePoints[CakeI].x - Gear^.X;
-        tdy := - CakePoints[CakeI].y + Gear^.Y;
-        CakePoints[CakeI].x := Gear^.X;
-        CakePoints[CakeI].y := Gear^.Y;
-        Gear^.DirAngle := DxDy2Angle(tdx, tdy);
+        cakeData:= PCakeData(Gear^.Data);
+        with cakeData^ do
+            begin
+            CakeI := (CakeI + 1) mod cakeh;
+            tdx := CakePoints[CakeI].x - Gear^.X;
+            tdy := - CakePoints[CakeI].y + Gear^.Y;
+            CakePoints[CakeI].x := Gear^.X;
+            CakePoints[CakeI].y := Gear^.Y;
+            Gear^.DirAngle := DxDy2Angle(tdx, tdy);
+            end;
         end;
 end;
 
 procedure doStepCakeUp(Gear: PGear);
 var
     i: Longword;
+    cakeData: PCakeData;
 begin
     AllInactive := false;
 
@@ -3259,12 +3258,16 @@
 
     if Gear^.Pos = 6 then
         begin
-        for i:= 0 to Pred(cakeh) do
+        cakeData:= PCakeData(Gear^.Data);
+        with cakeData^ do
             begin
-            CakePoints[i].x := Gear^.X;
-            CakePoints[i].y := Gear^.Y
+            for i:= 0 to Pred(cakeh) do
+                begin
+                CakePoints[i].x := Gear^.X;
+                CakePoints[i].y := Gear^.Y
+                end;
+            CakeI := 0;
             end;
-        CakeI := 0;
         Gear^.doStep := @doStepCakeWork
         end
     else
--- a/hedgewars/uGearsList.pas	Tue Mar 24 21:18:05 2015 +0100
+++ b/hedgewars/uGearsList.pas	Wed Mar 25 20:30:52 2015 +0100
@@ -166,6 +166,7 @@
 function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
 var gear: PGear;
     //c: byte;
+    cakeData: PCakeData;
 begin
 inc(GCounter);
 
@@ -193,6 +194,7 @@
 gear^.AmmoType:= GearKindAmmoTypeMap[Kind];
 gear^.CollisionMask:= $FFFF;
 gear^.Tint:= $FFFFFFFF;
+gear^.Data:= nil;
 
 if CurrentHedgehog <> nil then
     begin
@@ -507,7 +509,9 @@
                 if not dX.isNegative then
                     gear^.Angle:= 1
                 else
-                    gear^.Angle:= 3
+                    gear^.Angle:= 3;
+                New(cakeData);
+                gear^.Data:= Pointer(cakeData);
                 end;
  gtHellishBomb: begin
                 gear^.ImpactSound:= sndHellishImpact1;
@@ -660,6 +664,7 @@
 var team: PTeam;
     t,i: Longword;
     k: boolean;
+    cakeData: PCakeData;
 begin
 
 ScriptCall('onGearDelete', gear^.uid);
@@ -675,6 +680,12 @@
         if (Gear^.LinkedGear^.LinkedGear = Gear) then
             Gear^.LinkedGear^.LinkedGear:= nil;
     end
+else if Gear^.Kind = gtCake then
+    begin
+        cakeData:= PCakeData(Gear^.Data);
+        Dispose(cakeData);
+        cakeData:= nil;
+    end
 else if Gear^.Kind = gtHedgehog then
     (*
     This behaviour dates back to revision 4, and I accidentally encountered it with TARDIS.  I don't think it must apply to any modern weapon, since if it was actually hit, the best the gear could do would be to destroy itself immediately, and you'd still end up with two graves.  I believe it should be removed
--- a/hedgewars/uTypes.pas	Tue Mar 24 21:18:05 2015 +0100
+++ b/hedgewars/uTypes.pas	Wed Mar 25 20:30:52 2015 +0100
@@ -283,6 +283,7 @@
             Tint: LongWord;         // Used to colour a texture
             LinkedGear: PGear;      // Used to track a related gear. Portal pairs for example.
             SoundChannel: LongInt;  // Used to track a sound the gear started
+            Data: Pointer; // pointer to gear type specific data structure (if any)
             end;
     TPGearArray = array of PGear;
     PGearArrayS = record
@@ -516,6 +517,19 @@
             getDimensions, getImageDimensions: boolean;
             end;
 
+    // gear data types
+
+    const cakeh =   27;
+
+    type TCakeData = record
+        CakeI: integer;
+        CakePoints: array[0..Pred(cakeh)] of record
+            x, y: hwFloat;
+        end;
+    end;
+
+    PCakeData = ^TCakeData;
+
 implementation
 
 end.