Changeset 3 for trunk/UCore.pas

Timestamp:

Mar 6, 2011, 12:13:35 PM (13 years ago)

Author:

george

Message:

• Added: Drawing of tanks in eight directions.

File:

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

trunk/UCore.pas

@@ -1 +1 @@
 unit UCore;
 
-{$mode objfpc}{$H+}
+{$mode Delphi}{$H+}
 
 interface
 
 uses
-  Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix;
+  Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList;
 
 type
   TEngine = class;
 
-  TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock1, smRock2, smHouse1, smHouse2);
+  TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock,
+    smPlayer1H, smPlayer1L, smPlayer2H, smPlayer2L, smCannon, smBullet);
 
   TPlayerKeys = record
@@ -21 +22 @@
   end;
 
+  { TTank }
+
+  TTank = class
+    Image: TMatrixByte;
+    Mask: TMatrixByte;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
   { TPlayer }
 
   TPlayer = class
+  private
+    function ShowTankProc(Item1, Item2: Byte): Byte;
+    function HideTankProc(Item1, Item2: Byte): Byte;
+  public
+    Id: Integer;
     Engine: TEngine;
-    Color: TColor;
     Position: TPoint;
+    Direction: Integer;
     ScreenFrame: TRect;
     Name: string;
     Keys: TPlayerKeys;
+    Tanks: TListObject;
     procedure Control;
     procedure Paint;
+    procedure PlaceHouse;
+    function CheckColision: Boolean;
+    procedure ShowTank;
+    procedure HideTank;
+    procedure InitTanks;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -54 +77 @@
   private
     FBitmap: TBitmap;
+    FRedrawPending: Boolean;
     function GetPlayerCount: Integer;
     procedure SetBitmap(const AValue: TBitmap);
     procedure SetPlayerCount(const AValue: Integer);
+    procedure Redraw;
   public
     KeyState: array[0..High(Word)] of Boolean;
@@ -64 +89 @@
     destructor Destroy; override;
     procedure ResizePlayerFrames;
-    procedure Paint;
+    procedure Tick;
     property PlayerCount: Integer read GetPlayerCount write SetPlayerCount;
     property Bitmap: TBitmap read FBitmap write SetBitmap;
+    procedure NewGame;
   end;
 
 const
-  SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0, $2170c3, clGray, clGray + $808080, clGreen, clBlue);
+  SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0,
+    $2170c3, TColor($9a9a9a), TColor($00ff00), TColor($00a000),
+    TColor($ff2c2c), TColor($b60000), clYellow, clRed);
 
 var
@@ -76 +104 @@
 
 implementation
+
+{ TTank }
+
+constructor TTank.Create;
+begin
+  Mask := TMatrixByte.Create;
+  Image := TMatrixByte.Create;
+end;
+
+destructor TTank.Destroy;
+begin
+  Mask.Free;
+  Image.Free;
+  inherited Destroy;
+end;
 
 { TWorld }
@@ -97 +140 @@
     for X := 0 to Surface.Count.X - 1 do begin
       if Random < 0.5 then
-        Surface[Y, X] := Byte(smDirt1) else
-        Surface[Y, X] := Byte(smDirt2);
+        Surface.ItemsXY[Y, X] := Byte(smDirt1) else
+        Surface.ItemsXY[Y, X] := Byte(smDirt2);
     end;
 end;
@@ -107 +150 @@
 begin
   Surface := TMatrixByte.Create;
-  NewSize.X := 5000;
-  NewSize.Y := 500;
+  NewSize.X := 100;
+  NewSize.Y := 100;
   Size := NewSize;
 end;
@@ -121 +164 @@
 
 procedure TPlayer.Control;
-begin
-  if Engine.KeyState[Ord(Keys.Up)] then Position.Y := Position.Y + 1;
-  if Engine.KeyState[Ord(Keys.Down)] then Position.Y := Position.Y - 1;
-  if Engine.KeyState[Ord(Keys.Right)] then Position.X := Position.X + 1;
-  if Engine.KeyState[Ord(Keys.Left)] then Position.X := Position.X - 1;
+var
+  NewPosition: TPoint;
+  NewDirection: Integer;
+  Delta: TPoint;
+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.Right)] then Delta.X := Delta.X + 1;
+  if Engine.KeyState[Ord(Keys.Left)] then Delta.X := Delta.X - 1;
+
+  NewDirection := Direction;
+  if (Delta.X <> 0) or (Delta.Y <> 0) then begin
+    if (Delta.X = 0) and (Delta.Y = -1) then NewDirection := 0
+    else if (Delta.X = 1) and (Delta.Y = -1) then NewDirection := 1
+    else if (Delta.X = 1) and (Delta.Y = 0) then NewDirection := 2
+    else if (Delta.X = 1) and (Delta.Y = 1) then NewDirection := 3
+    else if (Delta.X = 0) and (Delta.Y = 1) then NewDirection := 4
+    else if (Delta.X = -1) and (Delta.Y = 1) then NewDirection := 5
+    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
+    HideTank;
+    Position := NewPosition;
+    Direction := NewDirection;
+    ShowTank;
+    Engine.Redraw;
+  end;
 end;
 
@@ -136 +206 @@
     Rectangle(ScreenFrame);
     //FillRect(ScreenFrame);
+
 
     with Engine.World do
@@ -143 +214 @@
         YY := Y - ScreenFrame.Top - ((ScreenFrame.Bottom - ScreenFrame.Top) div 2) + Position.Y;
         if (YY >= 0) and (YY < Surface.Count.Y) and (XX >= 0) and (XX < Surface.Count.X) then
-          Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter(Surface[YY, XX])];
+          Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter(Surface.ItemsXY[YY, XX])];
       end;
+
     (*CopyRect(ScreenFrame, Engine.World.Surface.Canvas,
     Rect(
@@ -157 +229 @@
 end;
 
+procedure TPlayer.PlaceHouse;
+const
+  HouseSize = 30;
+  DoorSize = 8;
+var
+  X, Y: Integer;
+  Matter: Byte;
+begin
+  for Y := 0 to HouseSize - 1 do
+    for X := 0 to HouseSize - 1 do begin
+      if ((Y = 0) or (Y = (HouseSize - 1)) or (X = 0) or (X = (HouseSize - 1))) and
+      not (((Y = 0) or (Y = (HouseSize - 1))) and (X > ((HouseSize - DoorSize) div 2)) and
+      (X < ((HouseSize - 1 + DoorSize) div 2)))
+      then Matter := Byte(smPlayer1H) + Id * 2
+        else Matter := Byte(smNothing);
+      Engine.World.Surface.ItemsXY[Position.Y - HouseSize div 2 + Y, Position.X - HouseSize div 2 + X] := Matter;
+    end;
+end;
+
+function TPlayer.CheckColision: Boolean;
+begin
+
+end;
+
+function TPlayer.ShowTankProc(Item1, Item2: Byte): Byte;
+begin
+  if Item2 > 0 then Result := Item2 else Result := Item1;
+end;
+
+procedure TPlayer.ShowTank;
+begin
+  with Engine.World do begin
+    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, ShowTankProc);
+  end;
+end;
+
+function TPlayer.HideTankProc(Item1, Item2: Byte): Byte;
+begin
+  if Item2 > 0 then Result := 0 else Result := Item1;
+end;
+
+procedure TPlayer.HideTank;
+begin
+  with Engine.World do begin
+    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, HideTankProc);
+  end;
+end;
+
+procedure TPlayer.InitTanks;
+var
+  NewTank: TTank;
+  I: Integer;
+  X, Y: Integer;
+begin
+  Tanks.Clear;
+
+  NewTank := TTank.Create;
+  with NewTank do begin
+    Image.Count := TMatrixByte.Point(7, 7);
+    for I := 0 to 3 do
+      Image[I, 3] := Byte(smCannon);
+    for I := 1 to 6 do begin
+      Image[I, 1] := Byte(smPlayer1H) + Id * 2;
+      Image[I, 5] := Byte(smPlayer1H) + Id * 2;
+    end;
+    for I := 2 to 5 do begin
+      Image[I, 2] := Byte(smPlayer1H) + Id * 2 + 1;
+      Image[I, 4] := Byte(smPlayer1H) + Id * 2 + 1;
+    end;
+    Image[4, 3] := Byte(smPlayer1H) + Id * 2 + 1;
+    Image[5, 3] := Byte(smPlayer1H) + Id * 2 + 1;
+  end;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  with NewTank do begin
+    Image.Count := TMatrixByte.Point(7, 7);
+    for I := 0 to 2 do
+      Image[3 - I, 3 + I] := Byte(smCannon);
+    for I := 0 to 3 do begin
+      Image[3 - I, I] := Byte(smPlayer1H) + Id * 2;
+      Image[6 - I, 3 + I] := Byte(smPlayer1H) + Id * 2;
+    end;
+    for I := 0 to 2 do begin
+      Image[3 - I, 1 + I] := Byte(smPlayer1H) + Id * 2 + 1;
+      Image[5 - I, 3 + I] := Byte(smPlayer1H) + Id * 2 + 1;
+    end;
+    Image[2, 3] := Byte(smPlayer1H) + Id * 2 + 1;
+    Image[3, 2] := Byte(smPlayer1H) + Id * 2 + 1;
+    Image[4, 2] := Byte(smPlayer1H) + Id * 2 + 1;
+    Image[4, 3] := Byte(smPlayer1H) + Id * 2 + 1;
+    Image[3, 4] := Byte(smPlayer1H) + Id * 2 + 1;
+  end;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[0]).Image);
+  NewTank.Image.Reverse;
+  NewTank.Image.ReverseHorizontal;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[1]).Image);
+  NewTank.Image.ReverseVertical;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[0]).Image);
+  NewTank.Image.ReverseVertical;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[1]).Image);
+  NewTank.Image.ReverseVertical;
+  NewTank.Image.ReverseHorizontal;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[0]).Image);
+  NewTank.Image.Reverse;
+  Tanks.Add(NewTank);
+
+  NewTank := TTank.Create;
+  NewTank.Image.Assign(TTank(Tanks[1]).Image);
+  NewTank.Image.ReverseHorizontal;
+  Tanks.Add(NewTank);
+
+  for I := 0 to Tanks.Count - 1 do
+  with TTank(Tanks[I]) do begin
+    Mask.Assign(Image);
+    for Y := 0 to Mask.Count.Y - 1 do
+    for X := 0 to Mask.Count.X - 1 do
+      if Mask.ItemsXY[X, Y] > 0 then Mask.ItemsXY[X, Y] := 1;
+  end;
+end;
+
+constructor TPlayer.Create;
+begin
+  Tanks := TListObject.Create;
+end;
+
+destructor TPlayer.Destroy;
+begin
+  Tanks.Free;
+  inherited Destroy;
+end;
+
 { TEngine }
 
@@ -179 +398 @@
       NewPlayer := TPlayer.Create;
       NewPlayer.Engine := Self;
+      NewPlayer.Id := I;
       NewPlayer.Name := 'Player ' + IntToStr(I);
+      NewPlayer.InitTanks;
       Players.Add(NewPlayer);
     end;
@@ -188 +409 @@
   end;
   ResizePlayerFrames;
+end;
+
+procedure TEngine.Redraw;
+begin
+  FRedrawPending := True;
 end;
 
@@ -224 +450 @@
 end;
 
-procedure TEngine.Paint;
+procedure TEngine.Tick;
 var
   I: Integer;
 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;
+  for I := 0 to Players.Count - 1 do begin
+    TPlayer(Players[I]).Control;
+  end;
+
+  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;
+    end;
+    FRedrawPending := False;
+  end;
+end;
+
+procedure TEngine.NewGame;
+var
+  I: Integer;
+  I2: Integer;
+begin
+  World.Generate;
+
+  for I := 0 to Players.Count - 1 do
+  with TPlayer(Players[I]) do
+  begin
+    // Reset position
+    Position := Point(25 + Random(World.Surface.Count.X - 50),
+      25 + Random(World.Surface.Count.Y - 50));
+
+    PlaceHouse;
   end;
 end;