Changeset 4 for trunk/UCore.pas

Timestamp:

Mar 6, 2011, 6:43:01 PM (14 years ago)

Author:

george

Message:

• Added: Complete map visualizaiton.
• Added: Generating map rock border.
• Added: Tank movement colision detection.
• Added: Some bullet shooting test.

File:

• trunk/UCore.pas (modified) (23 diffs)

trunk/UCore.pas

@@ -8 +8 @@
   Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList;
 
+const
+  MaxBulletCount = 10;
+
 type
   TEngine = class;
-
-  TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock,
-    smPlayer1H, smPlayer1L, smPlayer2H, smPlayer2L, smCannon, smBullet);
+  TPlayer = class;
+
+  TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock, smCannon, smBullet,
+    smPlayer1H, smPlayer1L, smPlayer2H, smPlayer2L,
+    smPlayer3H, smPlayer3L, smPlayer4H, smPlayer4L);
 
   TPlayerKeys = record
@@ -22 +27 @@
   end;
 
+  TBullet = class
+    Player: TPlayer;
+    Position: TPoint;
+    Direction: Integer;
+  end;
+
   { TTank }
 
@@ -35 +46 @@
   TPlayer = class
   private
+    NewDirection: Integer;
+    NewPosition: TPoint;
+    Dig: Boolean;
     function ShowTankProc(Item1, Item2: Byte): Byte;
     function HideTankProc(Item1, Item2: Byte): Byte;
@@ -46 +60 @@
     Keys: TPlayerKeys;
     Tanks: TListObject;
+    Bullets: TListObject;
     procedure Control;
     procedure Paint;
     procedure PlaceHouse;
-    function CheckColision: Boolean;
+    function CheckColision: TSurfaceMatter;
     procedure ShowTank;
     procedure HideTank;
@@ -69 +84 @@
     constructor Create;
     destructor Destroy; override;
+    procedure DrawToBitmap(Bitmap: TBitmap);
     property Size: TMatrixByteIndex read GetSize write SetSize;
   end;
@@ -78 +94 @@
     FBitmap: TBitmap;
     FRedrawPending: Boolean;
+    FBitmapLower: TBitmap;
     function GetPlayerCount: Integer;
     procedure SetBitmap(const AValue: TBitmap);
@@ -90 +107 @@
     procedure ResizePlayerFrames;
     procedure Tick;
+    procedure Draw;
     property PlayerCount: Integer read GetPlayerCount write SetPlayerCount;
     property Bitmap: TBitmap read FBitmap write SetBitmap;
@@ -97 +115 @@
 const
   SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0,
-    $2170c3, TColor($9a9a9a), TColor($00ff00), TColor($00a000),
-    TColor($ff2c2c), TColor($b60000), clYellow, clRed);
+    $2170c3, TColor($9a9a9a), clYellow, clRed,
+    TColor($00ff00), TColor($00a000), TColor($ff2c2c), TColor($b60000),
+    TColor($0000ff), TColor($0000a0), TColor($ff2cff), TColor($b600b6));
+  DirectionToDelta: array[0..7] of TPoint =
+    ((X: 0; Y: -1), (X: 1; Y: -1), (X: 1; Y: 0), (X: 1; Y: 1),
+    (X: 0; Y: 1), (X: -1; Y: 1), (X: -1; Y: 0), (X: -1; Y: -1));
 
 var
@@ -136 +158 @@
 var
   X, Y: Integer;
+  Distance: Double;
+  Delta: Double;
 begin
   for Y := 0 to Surface.Count.Y - 1 do
@@ -143 +167 @@
         Surface.ItemsXY[Y, X] := Byte(smDirt2);
     end;
+
+  Distance := 0.1 * Surface.Count.X;
+  Delta := 0;
+  for Y := 0 to Surface.Count.Y - 1 do begin
+    for X := 0 to Round(Distance) - 1 do begin
+      Surface.ItemsXY[Y, X] := Byte(smRock);
+    end;
+    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
+    Distance := Distance + Delta;
+  end;
+
+  Distance := 0.1 * Surface.Count.X;
+  Delta := 0;
+  for Y := 0 to Surface.Count.Y - 1 do begin
+    for X := 0 to Round(Distance) - 1 do begin
+      Surface.ItemsXY[Y, Surface.Count.X - 1 - X] := Byte(smRock);
+    end;
+    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
+    Distance := Distance + Delta;
+  end;
+
+  Distance := 0.1 * Surface.Count.Y;
+  Delta := 0;
+  for X := 0 to Surface.Count.X - 1 do begin
+    for Y := 0 to Round(Distance) - 1 do begin
+      Surface.ItemsXY[Y, X] := Byte(smRock);
+    end;
+    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
+    Distance := Distance + Delta;
+  end;
+
+  Distance := 0.1 * Surface.Count.Y;
+  Delta := 0;
+  for X := 0 to Surface.Count.X - 1 do begin
+    for Y := 0 to Round(Distance) - 1 do begin
+      Surface.ItemsXY[Surface.Count.Y - 1 - Y, X] := Byte(smRock);
+    end;
+    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
+    Distance := Distance + Delta;
+  end;
 end;
 
@@ -150 +214 @@
 begin
   Surface := TMatrixByte.Create;
-  NewSize.X := 100;
-  NewSize.Y := 100;
+  NewSize.X := 800;
+  NewSize.Y := 300;
   Size := NewSize;
 end;
@@ -161 +225 @@
 end;
 
+procedure TWorld.DrawToBitmap(Bitmap: TBitmap);
+var
+  X, Y: Integer;
+begin
+  try
+    Bitmap.BeginUpdate(True);
+  for Y := 0 to Bitmap.Height - 1 do
+    for X := 0 to Bitmap.Width - 1 do
+      Bitmap.Canvas.Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter(
+        Surface.ItemsXY[Trunc(Y / Bitmap.Height * Surface.Count.Y),
+        Trunc(X / Bitmap.Width * Surface.Count.X)])];
+  finally
+    Bitmap.EndUpdate;
+  end;
+end;
+
 { TPlayer }
 
 procedure TPlayer.Control;
 var
-  NewPosition: TPoint;
-  NewDirection: Integer;
   Delta: TPoint;
+  Matter: TSurfaceMatter;
+  NewBullet: TBullet;
+  I: Integer;
 begin
   Delta.X := 0;
   Delta.Y := 0;
-  if Engine.KeyState[Ord(Keys.Up)] then Delta.Y := Delta.Y + 1;
-  if Engine.KeyState[Ord(Keys.Down)] then Delta.Y := Delta.Y - 1;
+  if Engine.KeyState[Ord(Keys.Down)] then Delta.Y := Delta.Y + 1;
+  if Engine.KeyState[Ord(Keys.Up)] then Delta.Y := Delta.Y - 1;
   if Engine.KeyState[Ord(Keys.Right)] then Delta.X := Delta.X + 1;
   if Engine.KeyState[Ord(Keys.Left)] then Delta.X := Delta.X - 1;
@@ -186 +267 @@
     else if (Delta.X = -1) and (Delta.Y = 0) then NewDirection := 6
     else if (Delta.X = -1) and (Delta.Y = -1) then NewDirection := 7;
-  end;
-
-  NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
-  if CheckColision then begin
+
+    if NewDirection = Direction then
+      NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y)
+      else NewPosition := Position;
     HideTank;
-    Position := NewPosition;
-    Direction := NewDirection;
+    Matter := CheckColision;
+    if (Matter = smDirt1) then Dig := not Dig;
+    if (Matter = smNothing) or ((Matter = smDirt1) and (not Dig)) then begin
+      Position := NewPosition;
+      Direction := NewDirection;
+      Engine.Redraw;
+    end;
     ShowTank;
-    Engine.Redraw;
+  end;
+
+
+  if Engine.KeyState[Ord(Keys.Shoot)] then
+    if Bullets.Count < MaxBulletCount then begin
+      NewBullet := TBullet.Create;
+      NewBullet.Player := Self;
+      NewBullet.Position := Position;
+      NewBullet.Direction := Direction;
+      Bullets.Add(NewBullet);
+    end;
+
+  for I := Bullets.Count - 1 downto 0 do
+  with TBullet(Bullets[I]) do begin
+    Engine.World.Surface.ItemsXY[Position.Y, Position.X] := Byte(smNothing);
+
+    Position.X := Position.X + DirectionToDelta[Direction].X;
+    Position.Y := Position.Y + DirectionToDelta[Direction].Y;
+
+    with Engine.World.Surface do
+    if (Position.X >= Count.X) or (Position.X < 0) or
+      (Position.Y >= Count.Y) or (Position.Y < 0) then
+      Bullets.Delete(I) else
+      Engine.World.Surface.ItemsXY[Position.Y, Position.X] := Byte(smBullet);
   end;
 end;
@@ -203 +312 @@
   XX, YY: Integer;
 begin
-  with Engine.Bitmap.Canvas do begin
+  with Engine.FBitmapLower.Canvas do begin
     Rectangle(ScreenFrame);
-    //FillRect(ScreenFrame);
+    Brush.Color := SurfaceMatterColors[smRock];
+    FillRect(ScreenFrame);
 
 
@@ -248 +358 @@
 end;
 
-function TPlayer.CheckColision: Boolean;
-begin
-
+function TPlayer.CheckColision: TSurfaceMatter;
+var
+  X, Y: Integer;
+begin
+  Result := smNothing;
+  with Engine.World, TTank(Tanks[NewDirection]) do
+  for Y := 0 to Image.Count.Y - 1 do
+  for X := 0 to Image.Count.X - 1 do
+    if (Image.ItemsXY[Y, X] > 0) and
+    (Surface.ItemsXY[Y + NewPosition.Y, X + NewPosition.X] <> Byte(smNothing)) then
+    begin
+      Result := smDirt1;
+      if (Surface.ItemsXY[Y + NewPosition.Y, X + NewPosition.X] <> Byte(smDirt1)) and
+      (Surface.ItemsXY[Y + NewPosition.Y, X + NewPosition.X] <> Byte(smDirt2)) then
+      begin
+        Result := TSurfaceMatter(Surface.ItemsXY[Y + NewPosition.Y, X + NewPosition.X]);
+        Exit;
+      end;
+    end;
 end;
 
@@ -261 +387 @@
 begin
   with Engine.World do begin
-    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, ShowTankProc);
+    Surface.Merge(Surface.CreateIndex(Position.X, Position.Y), TTank(Tanks[Direction]).Image, ShowTankProc);
   end;
 end;
@@ -273 +399 @@
 begin
   with Engine.World do begin
-    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, HideTankProc);
+    Surface.Merge(Surface.CreateIndex(Position.X, Position.Y), TTank(Tanks[Direction]).Image, HideTankProc);
   end;
 end;
@@ -287 +413 @@
   NewTank := TTank.Create;
   with NewTank do begin
-    Image.Count := TMatrixByte.Point(7, 7);
+    Image.Count := Image.CreateIndex(7, 7);
     for I := 0 to 3 do
       Image[I, 3] := Byte(smCannon);
@@ -305 +431 @@
   NewTank := TTank.Create;
   with NewTank do begin
-    Image.Count := TMatrixByte.Point(7, 7);
+    Image.Count := Image.CreateIndex(7, 7);
     for I := 0 to 2 do
       Image[3 - I, 3 + I] := Byte(smCannon);
@@ -368 +494 @@
 begin
   Tanks := TListObject.Create;
+  Bullets := TListObject.Create;
 end;
 
 destructor TPlayer.Destroy;
 begin
+  Bullets.Free;
   Tanks.Free;
   inherited Destroy;
@@ -422 +550 @@
   I: Integer;
 begin
-  // TODO: Determine frames from player count
-  if Assigned(Bitmap) then begin
-    HorizFrameCount := 2;
-    VertFrameCount := 1;
+  if Assigned(FBitmapLower) then begin
+    if Players.Count > 1 then begin
+      if Players.Count > 2 then VertFrameCount := 2
+        else VertFrameCount := 1;
+      HorizFrameCount := Round(Players.Count / VertFrameCount);
+    end else begin
+      VertFrameCount := 1;
+      HorizFrameCount := 1;
+    end;
+    FBitmapLower.SetSize(80 * HorizFrameCount, 60 * VertFrameCount);
     for I := 0 to Players.Count - 1 do begin
       TPlayer(Players[I]).ScreenFrame := Rect(
-        (I mod HorizFrameCount) * (Bitmap.Width div HorizFrameCount),
-        (I div HorizFrameCount) * (Bitmap.Height div VertFrameCount),
-        ((I mod HorizFrameCount) + 1) * (Bitmap.Width div HorizFrameCount),
-        ((I div HorizFrameCount) + 1) * (Bitmap.Height div VertFrameCount));
-    end;
-  end;
+        (I mod HorizFrameCount) * (FBitmapLower.Width div HorizFrameCount),
+        (I div HorizFrameCount) * (FBitmapLower.Height div VertFrameCount),
+        ((I mod HorizFrameCount) + 1) * (FBitmapLower.Width div HorizFrameCount),
+        ((I div HorizFrameCount) + 1) * (FBitmapLower.Height div VertFrameCount));
+    end;
+  end;
+  Redraw;
 end;
 
 constructor TEngine.Create;
 begin
+  FBitmapLower := TBitmap.Create;
   Players := TObjectList.Create;
   World := TWorld.Create;
   World.Engine := Self;
+  Redraw;
 end;
 
 destructor TEngine.Destroy;
 begin
+  FBitmapLower.Free;
   Players.Free;
   World.Free;
@@ -457 +595 @@
     TPlayer(Players[I]).Control;
   end;
-
+end;
+
+procedure TEngine.Draw;
+var
+  I: Integer;
+begin
   if FRedrawPending then begin
-    if Assigned(Bitmap) then begin
-      Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
-      for I := 0 to Players.Count - 1 do begin
-        TPlayer(Players[I]).Control;
-        TPlayer(Players[I]).Paint;
-      end;
+    FBitmapLower.Canvas.FillRect(0, 0, FBitmapLower.Width, FBitmapLower.Height);
+    for I := 0 to Players.Count - 1 do begin
+      TPlayer(Players[I]).Paint;
+    end;
+    if Assigned(FBitmap) then begin
+      FBitmap.Canvas.StretchDraw(Rect(0, 0, FBitmap.Width, FBitmap.Height), FBitmapLower);
     end;
     FRedrawPending := False;
@@ -481 +624 @@
   begin
     // Reset position
-    Position := Point(25 + Random(World.Surface.Count.X - 50),
-      25 + Random(World.Surface.Count.Y - 50));
+    Position := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)),
+      Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6)));
 
     PlaceHouse;
   end;
+  Redraw;
 end;