source: trunk/Engine.pas

unit Engine;

interface

uses
  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, RegistryEx, Common,
  IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, Rectangle,
  Syncobjs, Threading, Forms, DateUtils, AudioSystem, Generics.Collections,
  World, Matter, Sound;

const
  MaxBulletCount = 10;
  EnergyDecreaseDig = 0;
  EnergyDecreaseMove = 0.00025; // ~2.5 minutes of movement
  EnergyDecreaseShoot = 0.005; // ~20 seconds of shooting
  EnergyDecreaseOutside = 0.00003; // ~5 minutes of live
  EnergyIncreaseHome = 0.001;
  ShieldIncreaseHome = 0.001;
  ShieldDecreaseHit = 0.15;
  ExplosionBulletCount = 100;
  ExplosionRange = 20;
  ExplosionBulletMaxSpeed = 0.5;
  ExplosionBulletMinSpeed = 0.2;
  BulletExplosionRange = 4;
  ShootDelay = 0.1; // seconds
  DigDelay = 0.2; // seconds
  ShootDigDelay = 0.05; // seconds
  MoveDelay = 0.05; // seconds
  PlayerFrameWidth = 80;
  PlayerFrameHeight = 80;
  PlayerHouseSize = 29;
  PlayerHouseDoorSize = 7;
  ExplosionDelay = 2;
  NewRoundDelay = 2;
  clTuna = $5555ff;
  clPurple = $aa00aa;
  clOrange = $0055aa;
  clDarkOrange = $0000aa;
  clDarkGreen = $00aa00;
  clCyan = $ffff00;

type
  TEngine = class;
  TPlayer = class;

  TRealPoint = record
    X, Y: Real;
  end;

  TPlayerKeys = record
    Left: Word;
    Right: Word;
    Up: Word;
    Down: Word;
    Shoot: Word;
  end;

  { TBullet }

  TBullet = class
    Player: TPlayer;
    Position: TRealPoint;
    PositionTail: TRealPoint;
    Direction: TRealPoint;
    MaxDistance: Integer;
    Distance: Real;
    StopByDirt: Boolean;
    CanKill: Boolean;
    constructor Create;
  end;

  { TBullets }

  TBullets = class(TObjectList<TBullet>)
    procedure HideAll;
  end;

  { TTank }

  TTank = class
    Image: TMatrixByte;
    Mask: TMatrixByte;
    procedure Assign(Source: TTank);
    constructor Create;
    destructor Destroy; override;
  end;

  { TTanks }

  TTanks = class(TObjectList<TTank>)
    procedure Assign(Source: TTanks);
  end;

  TColisionState = record
    Blocking: Boolean;
    Diggable: Boolean;
  end;

  { TPlayer }

  TPlayer = class
  private
    FExploded: Boolean;
    NewDirection: Integer;
    NewPosition: TPoint;
    Dig: Boolean;
    LastPos: TPoint;
    ExplosionPending: Boolean;
    ExplosionTime: TDateTime;
    procedure SetExploded(const AValue: Boolean);
    function ShowTankProc(Item1, Item2: Byte): Byte;
    function HideTankProc(Item1, Item2: Byte): Byte;
    function DigProc(Item1, Item2: Byte): Byte;
  public
    Name: string;
    Color1: TColor;
    Color2: TColor;
    Id: Integer;
    Enabled: Boolean;
    Engine: TEngine;
    Position: TPoint;
    StartPosition: TPoint;
    Score: Integer;
    Direction: Integer;
    ScreenFrame: TRectangle;
    Keys: TPlayerKeys;
    Tanks: TTanks;
    Bullets: TBullets;
    LastShootTime: TDateTime;
    LastDigTime: TDateTime;
    LastMoveTime: TDateTime;
    Energy: Real;
    LastEnergy: Real;
    Shield: Real;
    LastShield: Real;
    House: TRectangle;
    ShotsCount: Integer;
    ShotsHit: Integer;
    MetersDug: Integer;
    MetersTravelled: Integer;
    procedure ResetTank;
    procedure Init;
    procedure Explosion(Position: TPoint; Distance: Integer);
    procedure Control;
    function CheckNewDestination: Boolean;
    procedure Tick;
    procedure Paint;
    procedure PlaceHouse;
    function CheckColision: TColisionState;
    procedure ShowTank;
    procedure HideTank;
    procedure InitTanks;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPlayer);
    procedure LoadFromRegistry(Context: TRegistryContext);
    procedure SaveToRegistry(Context: TRegistryContext);
    property Exploded: Boolean read FExploded write SetExploded;
  end;

  { TPlayers }

  TPlayers = class(TObjectList<TPlayer>)
    Engine: TEngine;
    function AddNew: TPlayer;
    procedure Assign(Players: TPlayers);
    procedure LoadFromRegistry(Context: TRegistryContext);
    procedure SaveToRegistry(Context: TRegistryContext);
    function GetAliveCount: Integer;
    function GetWinner: TPlayer;
  end;

  { TKeyboard }

  TKeyboard = class
    KeyState: array[0..High(Word)] of Boolean;
    procedure ClearAll;
  end;

  { TSystemThread }

  TSystemThread = class(TListedThread)
    Engine: TEngine;
    procedure Execute; override;
  end;

  { TDrawThread }

  TDrawThread = class(TListedThread)
  private
    procedure DrawSync;
  public
    Engine: TEngine;
    procedure Execute; override;
  end;

  TCanvasMethod = procedure (Canvas: TCanvas) of object;

  TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
    gsInstructions);

  { TEngine }

  TEngine = class(TComponent)
  private
    FActive: Boolean;
    FBitmap: TBitmap;
    FBitmapLock: TCriticalSection;
    FOnGameEnd: TNotifyEvent;
    FRedrawPending: Boolean;
    FBitmapLower: TBitmapTColor;
    FDrawThread: TDrawThread;
    FState: TGameState;
    FSystemThread: TSystemThread;
    FClearBackground: Boolean;
    FStateTime: TDateTime;
    FShowMenuStats: Boolean;
    procedure InitDigMasks;
    procedure SetActive(const AValue: Boolean);
    procedure SetBitmap(const AValue: TBitmap);
    function IsInsideHouses(Pos: TPoint): Boolean;
    procedure InitPlayers;
    procedure CheckGameEnd;
    procedure ClearBackground;
    procedure DrawMenu;
    procedure DrawStats;
    procedure DrawGamePrepare(Thread: TVirtualThread);
    procedure DrawGame;
    procedure DrawInformation;
    procedure DrawInstructions;
    procedure DrawNewRound;
    procedure DrawMap;
    procedure SetState(AValue: TGameState);
    function TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
  public
    ThreadErrorMessage: string;
    Keyboard: TKeyboard;
    World: TWorld;
    PlayerPool: TPlayers;
    Players: TPlayers;
    DigMasks: TObjectList<TMatrixByte>;
    Lock: TCriticalSection;
    CurrentRound: Integer;
    MaxRound: Integer;
    AudioShot: TSound;
    AudioExplode: TSound;
    DrawDuration: TDatetime;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResizePlayerFrames;
    procedure Tick;
    procedure Redraw;
    procedure Draw;
    procedure DrawThread(Thread: TVirtualThread);
    procedure NewGame;
    procedure NewRound;
    procedure KeyUp(Key: Word);
    procedure KeyDown(Key: Word);
    procedure LoadFromRegistry(Context: TRegistryContext);
    procedure SaveToRegistry(Context: TRegistryContext);
    procedure InitPlayerPool;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property Active: Boolean read FActive write SetActive;
    property State: TGameState read FState write SetState;
    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
  end;

const
  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));


implementation

uses
  Platform, FastPixel;

resourcestring
  SRound = 'Round';
  SPressEsc = 'Press ESC to continue';
  SStartGame = 'Start game';
  SInstructions = 'Instructions';
  SInstructionsDetails = 'Tunneler is a two player game. The objective of the game is to be the first to win three rounds. ' +
    'A round continues until one tank blows up (from being shot or simply running out of energy).';
  SInstructionsDetails2 = 'The display: Each player has a view screen and an instrument panel with two meters. ' +
    'The view screen shows your surroundings from above (about 1% of the entire "worlds"). ' +
    'The two meters indicate the player''s energy and shield condition.';
  SInstructionsDetails3 = 'The Game: Players can move in one of 8 directions. ' +
    'Movement in tunnels is three times as fast as normal digging. ' +
    'Fast digging can be accomplished by firing the tank''s cannon while moving. ' +
    'Various actions use up different amounts of energy : moving costs some energy, digging costs more, and shotting costs the most. ' +
    'Shields are damaged when hit by the other player''s cannon. ' +
    'Players can refuel at either base but can repair their shields only at their own bases.';
  SInstructionsDetails4 = 'Controls: \n ' +
    'Blue: W - up, A - left, S - down, D - right, E - shoot \n ' +
    'Green: arrows key, CTRL - shoot';
  SInformation = 'Information';
  SInformationDetails = 'Tunneler is written from scratch in Lazarus/FPC. ' +
    'It is designed to be as similar as the original MS-DOS game (https://tunneler.org/) but also with some modern extensions. ' +
    'The program uses standard canvas drawing with combination of low resolution fast pixel matrix. ' +
    'It supports High DPI scaling. It supports up to eight players.';
  SInformationDetails2 = 'This is a public domain open source program: feel free to copy it for friends and study the source code. \n ' +
    'Homepage: https://app.zdechov.net/Tunneler';
  SWorldReady = 'World ready';
  SExit = 'Exit';
  SStatistics = 'Statistics';
  SShotsFired = 'Shots fired';
  SShotsHit = 'Shots hit';
  SPercentHit = 'Percent hit';
  SMetersDug = 'Meters dug';
  SMetersTravelled = 'Meters travelled';
  SWinnerIs = 'The winner is';
  SGreen = 'Green';
  SBlue = 'Blue';
  SRed = 'Red';
  SPink = 'Pink';
  SCyan = 'Cyan';
  SYellow = 'Yellow';
  SOrange = 'Orange';
  SGray = 'Gray';

{ TBullets }

procedure TBullets.HideAll;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  with Items[I] do begin
    Player.Engine.World.Surface.ItemsXY[Trunc(Position.X), Trunc(Position.Y)] := Byte(miSpace);
    Player.Engine.World.Surface.ItemsXY[Trunc(PositionTail.X), Trunc(PositionTail.Y)] := Byte(miSpace);
  end;
end;

{ TTanks }

procedure TTanks.Assign(Source: TTanks);
var
  I: Integer;
begin
  Clear;
  Count := Source.Count;
  for I := 0 to Count - 1 do begin
    Items[I] := TTank.Create;
    Items[I].Assign(Source.Items[I]);
  end;
end;

{ TPlayers }

function TPlayers.AddNew: TPlayer;
begin
  Result := TPlayer.Create;
  Add(Result);
end;

procedure TPlayers.Assign(Players: TPlayers);
var
  I: Integer;
begin
  while Count < Players.Count do Add(TPlayer.Create);
  while Count > Players.Count do Delete(Count - 1);
  for I := 0 to Count - 1 do
    Items[I].Assign(Players[I]);
end;

procedure TPlayers.LoadFromRegistry(Context: TRegistryContext);
var
  Player: TPlayer;
begin
  for Player in Self do begin
    Player.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
  end;
end;

procedure TPlayers.SaveToRegistry(Context: TRegistryContext);
var
  Player: TPlayer;
begin
  for Player in Self do begin
    Player.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
  end;
end;

function TPlayers.GetAliveCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
  with Items[I] do
    if not Exploded then Inc(Result);
end;

function TPlayers.GetWinner: TPlayer;
var
  I: Integer;
  TopScore: Integer;
begin
  Result := nil;
  TopScore := 0;
  for I := 0 to Count - 1 do
  with Items[I] do
  if Enabled and (Score > TopScore) then begin
    TopScore := Score;
    Result := Items[I];
  end;
end;

{ TSystemThread }

procedure TSystemThread.Execute;
begin
  try
    repeat
      Engine.Tick;
      Sleep(10);
    until Terminated;
  except
    on E: Exception do
      Engine.ThreadErrorMessage := E.Message;
  end;
end;

{ TDrawThread }

procedure TDrawThread.DrawSync;
begin
  with Engine do
  if Assigned(Bitmap) then begin
    Lock.Acquire;
    Bitmap.BeginUpdate(True);
    try
      Draw;
    finally
      Bitmap.EndUpdate;
      Lock.Release;
    end;
  end;
end;

procedure TDrawThread.Execute;
begin
  try
    repeat
      Engine.DrawThread(Self);
      if not Terminated then Synchronize(DrawSync);
      Sleep(50);
    until Terminated;
  except
    on E: Exception do
      Engine.ThreadErrorMessage := E.Message;
  end;
end;

{ TKeyboard }

procedure TKeyboard.ClearAll;
var
  I: Integer;
begin
  for I := 0 to High(KeyState) do
    KeyState[I] := False;
end;

{ TBullet }

constructor TBullet.Create;
begin
  MaxDistance := -1;
  Distance := 0;
  CanKill := True;
end;

{ TTank }

procedure TTank.Assign(Source: TTank);
begin
  Image.Assign(Source.Image);
  Mask.Assign(Source.Mask);
end;

constructor TTank.Create;
begin
  Mask := TMatrixByte.Create;
  Image := TMatrixByte.Create;
end;

destructor TTank.Destroy;
begin
  FreeAndNil(Mask);
  FreeAndNil(Image);
  inherited;
end;

{ TPlayer }

procedure TPlayer.Control;
var
  Delta: TPoint;
  NewBullet: TBullet;
begin
  if Exploded then Exit;

  Delta.X := 0;
  Delta.Y := 0;
  if Engine.KeyBoard.KeyState[Ord(Keys.Down)] then Delta.Y := Delta.Y + 1;
  if Engine.KeyBoard.KeyState[Ord(Keys.Up)] then Delta.Y := Delta.Y - 1;
  if Engine.KeyBoard.KeyState[Ord(Keys.Right)] then Delta.X := Delta.X + 1;
  if Engine.KeyBoard.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;

    if NewDirection = Direction then begin
      NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
      CheckNewDestination;
    end else begin
      NewPosition := Position;
      if not CheckNewDestination then begin
        // if direction is changed then try to check movement plus one step
        // to prevent tank block
        NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
        CheckNewDestination;
      end;
    end;
  end;

  if Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] then
    if (Bullets.Count < MaxBulletCount) and
    ((Now - LastShootTime) > ShootDelay * OneSecond) then begin
      Inc(ShotsCount);
      NewBullet := TBullet.Create;
      NewBullet.Player := Self;
      NewBullet.Position.X := Position.X + DirectionToDelta[Direction].X * 3;
      NewBullet.Position.Y := Position.Y + DirectionToDelta[Direction].Y * 3;
      NewBullet.Direction.X := DirectionToDelta[Direction].X;
      NewBullet.Direction.Y := DirectionToDelta[Direction].Y;
      NewBullet.StopByDirt := True;
      Bullets.Add(NewBullet);
      LastShootTime := Now;

      Energy := Energy - EnergyDecreaseShoot;
      if Energy < 0 then Energy := 0;

      // Do not imedietelly clear dirt by bullet in front of tank
      //with Engine, World do
      //if TMatter(Matter[Surface.Items[Position]]).Diggable ;
      Engine.AudioShot.Play;
    end;
end;

function TPlayer.CheckNewDestination: Boolean;
var
  ColisionState: TColisionState;
begin
  Result := False;
  HideTank;
  ColisionState := CheckColision;
  if not ColisionState.Blocking then begin
    if ColisionState.Diggable then begin
      if (Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] and
      ((Now - LastDigTime) > ShootDigDelay * OneSecond)) or
      (not Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] and
      ((Now - LastDigTime) > DigDelay * OneSecond)) then begin
        Dig := not Dig;
        with Engine, World do
        Surface.Merge(Surface.CreateIndex(
          Position.X - TMatrixByte(DigMasks[Direction]).Count.X div 2,
          Position.Y - TMatrixByte(DigMasks[Direction]).Count.Y div 2),
          TMatrixByte(DigMasks[Direction]), DigProc);
        Energy := Energy - EnergyDecreaseDig;
        if Energy < 0 then Energy := 0;
        Engine.Redraw;
        LastDigTime := Now;
        Direction := NewDirection;
        Result := True;
        Inc(MetersDug);
      end;
    end else begin
      if ((Now - LastMoveTime) > MoveDelay * OneSecond) then begin
        Position := NewPosition;
        Direction := NewDirection;
        Result := True;
        Engine.Redraw;
        LastMoveTime := Now;
        Energy := Energy - EnergyDecreaseMove;
        Inc(MetersTravelled);
      end;
    end;
  end;
  ShowTank;
end;

procedure TPlayer.Tick;
var
  I: Integer;
  P: Integer;
  Pos: TPoint;
begin
  // Check energy
  if not ExplosionPending then begin
    if not Engine.IsInsideHouses(Position) then begin
      Energy := Energy - EnergyDecreaseOutside;
    end else begin
      if not Exploded then
        Energy := Energy + EnergyIncreaseHome;
      if Energy > 1 then Energy := 1;
    end;
    if Energy <= 0 then begin
      Energy := 0;
      Explosion(Position, ExplosionRange);
      Exploded := True;
      ExplosionPending := True;
      ExplosionTime := Now;
      Engine.AudioExplode.Play;
    end;
  end;
  if ExplosionPending and (SecondOf(Now - ExplosionTime) > ExplosionDelay) then begin
    ExplosionPending := False;
    Engine.CheckGameEnd;
  end;
  if LastEnergy <> Energy then begin
    LastEnergy := Energy;
    Engine.Redraw;
  end;

  // Check shield
  if House.IsInside(Position) then begin
    if not Exploded then
      Shield := Shield + ShieldIncreaseHome;
    if Shield > 1 then Shield := 1;
  end;
  if LastShield <> Shield then begin
    LastShield := Shield;
    Engine.Redraw;
  end;
  if (Shield <= 0) and not Exploded then begin
    Shield := 0;
    Explosion(Position, ExplosionRange);
    Exploded := True;
    Engine.AudioExplode.Play;
  end;

  // Bullet movement
  for I := Bullets.Count - 1 downto 0 do
  with Bullets[I], Engine.World.Surface do begin
    Pos := Point(Trunc(Position.X), Trunc(Position.Y));
    if (ItemsXY[LastPos.X, LastPos.Y] = Byte(miBullet1)) or
      (ItemsXY[LastPos.X, LastPos.Y] = Byte(miBullet2)) then
      ItemsXY[LastPos.X, LastPos.Y] := Byte(miSpace);
    LastPos := Pos;
    P := Trunc(Direction.Y);

    PositionTail := Position;
    Position.X := Position.X + Direction.X;
    Position.Y := Position.Y + Direction.Y;
    Distance := Distance + Sqrt(Sqr(Direction.X) + Sqr(Direction.Y));
    //ShowMessage(FloatToStr(Distance));
    if (Distance > MaxDistance) and (MaxDistance >= 0) then begin
      Bullets.Delete(I);
      Engine.Redraw;
      Continue;
    end;

    Pos := Point(Trunc(Position.X), Trunc(Position.Y));

    if (ItemsXY[Pos.X, Pos.Y] <> Byte(miSpace)) and
    (ItemsXY[Pos.X, Pos.Y] <> Byte(miBullet1)) and
    (ItemsXY[Pos.X, Pos.Y] <> Byte(miBullet2)) then begin
      if (ItemsXY[Pos.X, Pos.Y] = Byte(miDirt1)) or
        (ItemsXY[Pos.X, Pos.Y] = Byte(miDirt2)) then begin
          //ItemsXY[Pos.X, Pos.Y] := Byte(miSpace);
          if StopByDirt then begin
            Explosion(LastPos, BulletExplosionRange);
            Bullets.Delete(I);
            Engine.Redraw;
            Continue;
          end;
        end else begin
          for P := 0 to Engine.Players.Count - 1 do
          with Engine.Players[P] do
          if (Self.Id <> P) and
            (Engine.World.Matters[ItemsXY[Pos.X, Pos.Y]].Kind = mkTankBody) and
            (Engine.World.Matters[ItemsXY[Pos.X, Pos.Y]].Player = P) and CanKill then begin
              Shield := Shield - ShieldDecreaseHit;
              Inc(Self.ShotsHit);
            end;
          if StopByDirt then Explosion(LastPos, BulletExplosionRange);
          Bullets.Delete(I);
          Engine.Redraw;
          Continue;
        end;
    end;

    // Max position limit checking
    with Engine.World.Surface do
    if (Pos.X >= Count.X) or (Pos.X < 0) or
      (Pos.Y >= Count.Y) or (Pos.Y < 0) then begin
        Bullets.Delete(I);
        Engine.Redraw;
        Continue;
      end;
    ItemsXY[Pos.X, Pos.Y] := Byte(miBullet1);
    ItemsXY[LastPos.X, LastPos.Y] := Byte(miBullet2);
    Engine.Redraw;
  end;

  if (Engine.State = gsGame) and not Exploded then ShowTank;
end;

procedure TPlayer.Paint;
var
  X, Y: Integer;
  XX, YY: Integer;
  I: Integer;
  B: TColor;
begin
  with Engine.FBitmapLower do begin
    Fill(CreateIndex(ScreenFrame.Left, ScreenFrame.Top),
      CreateIndex(ScreenFrame.Width, ScreenFrame.Height),
      Engine.World.Matters[Integer(miRock)].Color);

    with Engine.World do
    for Y := ScreenFrame.Top to ScreenFrame.Bottom - 1 do
      for X := ScreenFrame.Left to ScreenFrame.Right - 1 do begin
        XX := X - ScreenFrame.Left - ((ScreenFrame.Right - ScreenFrame.Left) div 2) + Position.X;
        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 begin
          B := Engine.World.Matters[Surface.ItemsXY[XX, YY]].Color;
          ItemsXY[X, Y] := B;
        end;
      end;

    // Energy bar
    for I := 1 to ScreenFrame.Width - 2 do
      if Energy < I / (ScreenFrame.Width - 2) then
        ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 2] := clBlack
        else ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 2] := clYellow;

    // Shield bar
    for I := 1 to ScreenFrame.Width - 2 do
      if Shield < I / (ScreenFrame.Width - 2) then
        ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 1] := clBlack
        else ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 1] := clAqua;
  end;
end;

procedure TPlayer.PlaceHouse;
var
  X, Y: Integer;
  Matter: Byte;
begin
  House.AsTRect := Rect(Position.X - PlayerHouseSize div 2, Position.Y - PlayerHouseSize div 2,
    Position.X + PlayerHouseSize div 2, Position.Y + PlayerHouseSize div 2);
  for Y := 0 to PlayerHouseSize - 1 do
    for X := 0 to PlayerHouseSize - 1 do begin
      if ((Y = 0) or (Y = (PlayerHouseSize - 1)) or (X = 0) or (X = (PlayerHouseSize - 1))) and
      not (((Y = 0) or (Y = (PlayerHouseSize - 1))) and
      (X >= ((PlayerHouseSize - PlayerHouseDoorSize) div 2)) and
      (X <= ((PlayerHouseSize - 1 + PlayerHouseDoorSize) div 2)))
      then Matter := Byte(miPlayer1Home) + Id * 4
        else Matter := Byte(miSpace);
      Engine.World.Surface.ItemsXY[House.Left + X,
        House.Top + Y] := Matter;
    end;
end;

function TPlayer.CheckColision: TColisionState;
var
  X, Y: Integer;
  XX, YY: Integer;
begin
  Result.Diggable := False;
  Result.Blocking := False;
  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 begin
    XX := X + NewPosition.X - Image.Count.X div 2;
    YY := Y + NewPosition.Y - Image.Count.Y div 2;
    if Image.ItemsXY[X, Y] > 0 then begin
      if TMatter(Matters[Surface.ItemsXY[XX, YY]]).Blocking then
        Result.Blocking := True;
      if TMatter(Matters[Surface.ItemsXY[XX, YY]]).Diggable then
        Result.Diggable := True;
    end;
  end;
end;

function TPlayer.ShowTankProc(Item1, Item2: Byte): Byte;
begin
  if Item2 > 0 then Result := Item2
    else Result := Item1;
end;

procedure TPlayer.SetExploded(const AValue: Boolean);
begin
  if FExploded = AValue then Exit;
  FExploded := AValue;
  if FExploded then begin
    HideTank;
    Energy := 0;
    Shield := 0;
  end else ShowTank;
end;

procedure TPlayer.ShowTank;
begin
  with Engine.World do begin
    Surface.Merge(Surface.CreateIndex(
      Position.X - Tanks[Direction].Image.Count.X div 2,
      Position.Y - Tanks[Direction].Image.Count.Y div 2),
      Tanks[Direction].Image, ShowTankProc);
  end;
end;

function TPlayer.HideTankProc(Item1, Item2: Byte): Byte;
begin
  if Item2 > 0 then Result := 0 else Result := Item1;
end;

function TPlayer.DigProc(Item1, Item2: Byte): Byte;
begin
  if ((Item1 = Integer(miDirt1)) or (Item1 = Integer(miDirt2))) and (Item2 = 1) then
    Result := Integer(miSpace) else Result := Item1;
end;

procedure TPlayer.ResetTank;
begin
  HideTank;
  Position := StartPosition;
  ExplosionPending := False;
  Bullets.HideAll;
  Bullets.Clear;
  Energy := 1;
  Shield := 1;
  Direction := 0;
  ShowTank;
  Exploded := False;
end;

procedure TPlayer.Init;
begin
  with Engine do
    StartPosition := 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)));
  Position := StartPosition;
  PlaceHouse;
  ShotsCount := 0;
  ShotsHit := 0;
  MetersDug := 0;
  MetersTravelled := 0;
end;

procedure TPlayer.Explosion(Position: TPoint; Distance: Integer);
var
  NewBullet: TBullet;
  I: Integer;
  Speed: Real;
  Angle: Real;
begin
  if not Exploded then begin
    for I := 0 to Distance * 2 - 1 do begin
      NewBullet := TBullet.Create;
      NewBullet.Player := Self;
      Speed := ExplosionBulletMinSpeed + (ExplosionBulletMaxSpeed - ExplosionBulletMinSpeed) * Random;
      Angle := Random * 2 * Pi;
      NewBullet.Direction.X := Sin(Angle) * Speed;
      NewBullet.Direction.Y := Cos(Angle) * Speed;
      NewBullet.Position.X := Position.X; // + NewBullet.Direction.X * 3;
      NewBullet.Position.Y := Position.Y; // + NewBullet.Direction.Y * 3;
      NewBullet.MaxDistance := Random(Distance);
      NewBullet.CanKill := False;
      Bullets.Add(NewBullet);
    end;
  end;
end;

procedure TPlayer.HideTank;
begin
  with Engine.World do begin
    Surface.Merge(Surface.CreateIndex(
      Position.X - Tanks[Direction].Image.Count.X div 2,
      Position.Y - Tanks[Direction].Image.Count.Y div 2),
      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 := Image.CreateIndex(7, 7);
    for I := 0 to 3 do
      Image[3, I] := Byte(miPlayer1Cannon) + Id * 4;
    for I := 1 to 6 do begin
      Image[1, I] := Byte(miPlayer1TankBody) + Id * 4;
      Image[5, I] := Byte(miPlayer1TankBody) + Id * 4;
    end;
    for I := 2 to 5 do begin
      Image[2, I] := Byte(miPlayer1TankBody2) + Id * 4;
      Image[4, I] := Byte(miPlayer1TankBody2) + Id * 4;
    end;
    Image[3, 4] := Byte(miPlayer1TankBody2) + Id * 4;
    Image[3, 5] := Byte(miPlayer1TankBody2) + Id * 4;
  end;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  with NewTank do begin
    Image.Count := Image.CreateIndex(7, 7);
    for I := 0 to 2 do
      Image[3 + I, 3 - I] := Byte(miPlayer1Cannon) + Id * 4;
    for I := 0 to 3 do begin
      Image[I, 3 - I] := Byte(miPlayer1TankBody) + Id * 4;
      Image[3 + I, 6 - I] := Byte(miPlayer1TankBody) + Id * 4;
    end;
    for I := 0 to 2 do begin
      Image[1 + I, 3 - I] := Byte(miPlayer1TankBody2) + Id * 4;
      Image[3 + I, 5 - I] := Byte(miPlayer1TankBody2) + Id * 4;
    end;
    Image[3, 2] := Byte(miPlayer1TankBody2) + Id * 4;
    Image[2, 3] := Byte(miPlayer1TankBody2) + Id * 4;
    Image[2, 4] := Byte(miPlayer1TankBody2) + Id * 4;
    Image[3, 4] := Byte(miPlayer1TankBody2) + Id * 4;
    Image[4, 3] := Byte(miPlayer1TankBody2) + Id * 4;
  end;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[0].Image);
  NewTank.Image.Reverse;
  NewTank.Image.ReverseHorizontal;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[1].Image);
  NewTank.Image.ReverseVertical;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[0].Image);
  NewTank.Image.ReverseVertical;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[1].Image);
  NewTank.Image.ReverseVertical;
  NewTank.Image.ReverseHorizontal;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[0].Image);
  NewTank.Image.Reverse;
  Tanks.Add(NewTank);

  NewTank := TTank.Create;
  NewTank.Image.Assign(Tanks[1].Image);
  NewTank.Image.ReverseHorizontal;
  Tanks.Add(NewTank);

  for I := 0 to Tanks.Count - 1 do
  with 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 := TTanks.Create;
  Bullets := TBullets.Create;
  House := TRectangle.Create;
  ScreenFrame := TRectangle.Create;
end;

destructor TPlayer.Destroy;
begin
  FreeAndNil(ScreenFrame);
  FreeAndNil(House);
  FreeAndNil(Bullets);
  FreeAndNil(Tanks);
  inherited;
end;

procedure TPlayer.Assign(Source: TPlayer);
begin
  Engine := Source.Engine;
  Id := Source.Id;
  Keys := Source.Keys;
  Color1 := Source.Color1;
  Color2 := Source.Color2;
  Energy := Source.Energy;
  Shield := Source.Shield;
  Name := Source.Name;
  Enabled := Source.Enabled;
  Position := Source.Position;
  StartPosition := Source.StartPosition;
  Score := Source.Score;
  ShotsCount := Source.ShotsCount;
  ShotsHit := Source.ShotsHit;
  MetersDug := Source.MetersDug;
  MetersTravelled := Source.MetersTravelled;
  FExploded := Source.FExploded;
  Tanks.Assign(Source.Tanks);
end;

procedure TPlayer.LoadFromRegistry(Context: TRegistryContext);
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Context;
    Name := ReadStringWithDefault('Name', Name);
    Color1 := ReadIntegerWithDefault('Color1', Color1);
    Color2 := ReadIntegerWithDefault('Color2', Color2);
    Enabled := ReadBoolWithDefault('Enabled', Enabled);
    Keys.Left := ReadIntegerWithDefault('KeysLeft', Keys.Left);
    Keys.Right := ReadIntegerWithDefault('KeyRight', Keys.Right);
    Keys.Down := ReadIntegerWithDefault('KeyDown', Keys.Down);
    Keys.Up := ReadIntegerWithDefault('KeyUp', Keys.Up);
    Keys.Shoot := ReadIntegerWithDefault('KeyShoot', Keys.Shoot);
  finally
    Free;
  end;
end;

procedure TPlayer.SaveToRegistry(Context: TRegistryContext);
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Context;
    WriteString('Name', Name);
    WriteInteger('Color1', Color1);
    WriteInteger('Color2', Color2);
    WriteBool('Enabled', Enabled);
    WriteInteger('KeysLeft', Keys.Left);
    WriteInteger('KeyRight', Keys.Right);
    WriteInteger('KeyDown', Keys.Down);
    WriteInteger('KeyUp', Keys.Up);
    WriteInteger('KeyShoot', Keys.Shoot);
  finally
    Free;
  end;
end;

{ TEngine }

procedure TEngine.SetActive(const AValue: Boolean);
begin
  if FActive = AValue then Exit;
  FActive := AValue;
  if AValue then begin
    FDrawThread := TDrawThread.Create(True);
    FDrawThread.Engine := Self;
    FDrawThread.FreeOnTerminate := False;
    FDrawThread.Name := 'Draw';
    FDrawThread.Start;
    FSystemThread := TSystemThread.Create(True);
    FSystemThread.Engine := Self;
    FSystemThread.FreeOnTerminate := False;
    FSystemThread.Name := 'Engine';
    FSystemThread.Start;
  end else begin
    FDrawThread.Terminate;
    Application.ProcessMessages;
    FreeAndNil(FDrawThread);
    FreeAndNil(FSystemThread);
  end;
end;

procedure TEngine.SetBitmap(const AValue: TBitmap);
begin
  FBitmap := AValue;
  ResizePlayerFrames;
end;

procedure TEngine.Redraw;
begin
  FRedrawPending := True;
end;

function TEngine.IsInsideHouses(Pos: TPoint): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Players.Count - 1 do
    if Players[I].House.IsInside(Pos) then begin
      Result := True;
    end;
end;

procedure TEngine.DrawGame;
var
  X, Y: Integer;
  PixelX, PixelY: Integer;
  SubPixelPtr: PInteger;
  SubPixelRowPtr: PInteger;
  SubPixelSizeX: Integer;
  SubPixelSizeY: Integer;
  PixelPtr: PInteger;
  PixelRowPtr: PInteger;
  BytePerPixel: Integer;
  BytePerRow: Integer;
  RawImage: TRawImage;
  Color: Int64;
  Shift: TPoint;
  XDiv, XMod, XAcc: Integer;
  YDiv, YMod, YAcc: Integer;
  Ratio: Real;
  TargetHeight: Integer;
  TargetWidth: Integer;
  BgColor: Cardinal;
begin
  // TODO: To be able to draw into Bitmap not just through Canvas
  Bitmap.EndUpdate;
  Bitmap.BeginUpdate;

  {$IFDEF WINDOWS}
  Bitmap.PixelFormat := pf32bit;
  {$ENDIF}
  RawImage := Bitmap.RawImage;
  BytePerPixel := RawImage.Description.BitsPerPixel div 8;
  BytePerRow := RawImage.Description.BytesPerLine;
  if FClearBackground then begin
    BgColor := World.Matters[Integer(miBorder)].Color;
    BgColor := SwapBRComponent(BgColor);
    FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
    FClearBackground := False;
  end;

  if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
    Ratio := FBitmap.Width / FBitmapLower.Width
    else Ratio := FBitmap.Height / FBitmapLower.Height;

  // Preserve aspect ratio
  TargetWidth := Trunc(FBitmapLower.Width * Ratio);
  TargetHeight := Trunc(FBitmapLower.Height * Ratio);

  Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
  Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);

  XDiv := TargetWidth div FBitmapLower.Width;
  XMod := TargetWidth mod FBitmapLower.Width;
  YDiv := TargetHeight div FBitmapLower.Height;
  YMod := TargetHeight mod FBitmapLower.Height;

  PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
  YAcc := FBitmapLower.Height div 2;
  for Y := 0 to FBitmapLower.Height - 1 do begin
    SubPixelSizeY := YDiv;
    Inc(YAcc, YMod);
    if YAcc >= FBitmapLower.Height then begin
      Dec(YAcc, FBitmapLower.Height);
      Inc(SubPixelSizeY);
    end;

    PixelPtr := PixelRowPtr + Shift.X;
    XAcc := FBitmapLower.Width div 2;
    for X := 0 to FBitmapLower.Width - 1 do begin
      SubPixelSizeX := XDiv;
      Inc(XAcc, XMod);
      if XAcc >= FBitmapLower.Width then begin
        Dec(XAcc, FBitmapLower.Width);
        Inc(SubPixelSizeX);
      end;
      Color := FBitmapLower.Pixels[X, Y] and $ffffff;

      Color := SwapBRComponent(Color);

      // Draw large pixel
      SubPixelRowPtr := PixelPtr;
      for PixelY := 0 to SubPixelSizeY - 1 do begin
        SubPixelPtr := SubPixelRowPtr;
        for PixelX := 0 to SubPixelSizeX - 1 do begin
          SubPixelPtr^ := Color;
          Inc(PByte(SubPixelPtr), BytePerPixel);
        end;
        Inc(PByte(SubPixelRowPtr), BytePerRow);
      end;
      Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
    end;
    Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
      end;
end;

procedure TEngine.DrawInformation;
var
  Text: string;
  X: Integer;
  Y: Integer;
const
  LineHeight = 60;
begin
  with Bitmap.Canvas do begin
    ClearBackground;

    X := Bitmap.Width div 2;
    Y := Bitmap.Height div 20;

    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clWhite;
    Font.Color := clGreen;
    Font.Size := 30;
    Text := SInformation;
    TextOut(X - TextWidth(Text) div 2, Y, Text);
    Inc(Y, 2 * LineHeight);

    X := 30;

    Font.Color := clYellow;
    Font.Size := 20;
    Text := SInformationDetails;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    Text := SInformationDetails2;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    X := Bitmap.Width div 2;

    Font.Color := clGreen;
    Font.Size := 30;
    Text := SPressEsc;
    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
  end;
end;

procedure TEngine.DrawInstructions;
var
  Text: string;
  X: Integer;
  Y: Integer;
const
  LineHeight = 60;
begin
  with Bitmap.Canvas do begin
    ClearBackground;

    X := Bitmap.Width div 2;
    Y := Bitmap.Height div 20;

    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clWhite;
    Font.Color := clTuna;
    Font.Size := 30;
    Text := SInstructions;
    TextOut(X - TextWidth(Text) div 2, Y, Text);
    Inc(Y, 2 * LineHeight);

    X := 30;

    Font.Color := clTeal;
    Font.Size := 20;
    Text := SInstructionsDetails;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    Text := SInstructionsDetails2;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    Text := SInstructionsDetails3;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    Text := SInstructionsDetails4;
    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    Inc(Y, LineHeight);

    X := Bitmap.Width div 2;
    Font.Color := clGreen;
    Font.Size := 30;
    Text := SPressEsc;
    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
  end;
end;

procedure TEngine.DrawNewRound;
var
  Text: string;
  I: Integer;
  Y: Integer;
begin
  with Bitmap.Canvas do begin
    ClearBackground;

    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clWhite;
    Font.Color := clTuna;
    Font.Size := 30;
    Text := SRound + ' ' + IntToStr(CurrentRound);
    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text);

    Y := 0;
    for I := 0 to Players.Count - 1 do
    with TPlayer(Players[I]) do begin
      if Enabled then begin
        Font.Color := Color1;
        Text := Name + ': ' + IntToStr(Score);
        TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text);
        Inc(Y, 60);
      end;
    end;
  end;
end;

procedure TEngine.DrawMap;
var
  Text: string;
begin
  Bitmap.EndUpdate;
  Bitmap.BeginUpdate;

  World.DrawToBitmap(Bitmap);

  Bitmap.EndUpdate;
  Bitmap.BeginUpdate(True);
  with Bitmap.Canvas do begin
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Font.Color := clGreen;
    Font.Size := 30;
    Text := SPressEsc;
    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
  end;
end;

procedure TEngine.SetState(AValue: TGameState);
begin
  if FState = AValue then Exit;
  FState := AValue;
  FRedrawPending := True;
  FStateTime := Now;
end;

function TEngine.TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
var
  Parts: TStringArray;
  I: Integer;
  XX: Integer;
begin
  Result := 1;
  XX := 0;
  Parts := Explode(' ', Text);
  for I := 0 to Length(Parts) - 1 do begin
    if (X + XX + Canvas.TextWidth(Parts[I]) > Width) or (Parts[I] = '\n') then begin
      Y := Y + Canvas.TextHeight(Parts[I]);
      XX := 0;
      Inc(Result);
    end;
    if Parts[I] = '\n' then Continue;
    Canvas.TextOut(X + XX, Y, Parts[I]);
    XX := XX + Canvas.TextWidth(Parts[I]) + Canvas.TextWidth(' ');
  end;
end;

procedure TEngine.InitDigMasks;
var
  NewMask: TMatrixByte;
  I: Integer;
begin
  DigMasks.Clear;

  // 001111100
  // 0111A1110
  // 00z1A1z00
  // 00zxAxz00
  // 00zxAxz00
  // 00zxxxz00
  // 00z000z00
  // 000000000
  // 000000000

  NewMask := TMatrixByte.Create;
  with NewMask do begin
    Count := CreateIndex(9, 9);
    for I := 0 to 4 do ItemsXY[2 + I, 0] := 1;
    for I := 0 to 2 do begin
      ItemsXY[1 + I, 1] := 1;
      ItemsXY[5 + I, 1] := 1;
    end;
    ItemsXY[3, 2] := 1;
    ItemsXY[5, 2] := 1;
  end;
  DigMasks.Add(NewMask);

  // 000011110
  // 0000z1111
  // 000zx1A11
  // 00zxxA111
  // 0zxxAxxz1
  // 000xxxz00
  // 0000xz000
  // 0000z0000
  // 000000000

  NewMask := TMatrixByte.Create;
  with NewMask do begin
    Count := CreateIndex(9, 9);
    for I := 0 to 3 do begin
      ItemsXY[4 + I, 0] := 1;
      ItemsXY[5 + I, 1] := 1;
    end;
    ItemsXY[5, 2] := 1;
    ItemsXY[7, 2] := 1;
    ItemsXY[8, 2] := 1;
    for I := 0 to 2 do
      ItemsXY[6 + I, 3] := 1;
    ItemsXY[8, 4] := 1;
  end;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[0]);
  NewMask.Reverse;
  NewMask.ReverseHorizontal;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[1]);
  NewMask.ReverseVertical;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[0]);
  NewMask.ReverseVertical;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[1]);
  NewMask.ReverseVertical;
  NewMask.ReverseHorizontal;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[0]);
  NewMask.Reverse;
  DigMasks.Add(NewMask);

  NewMask := TMatrixByte.Create;
  NewMask.Assign(DigMasks[1]);
  NewMask.ReverseHorizontal;
  DigMasks.Add(NewMask);
end;

procedure TEngine.InitPlayerPool;
var
  I: Integer;
begin
  PlayerPool.Clear;
  with PlayerPool.AddNew do begin
    Name := SGreen;
    Keys.Left := 65;
    Keys.Down := 83;
    Keys.Right := 68;
    Keys.Up := 87;
    Keys.Shoot := 69;
    Color1 := $00ff00;
    Color2 := $00a000;
    Enabled := True;
  end;
  with PlayerPool.AddNew do begin
    Name := SBlue;
    Keys.Left := 37;
    Keys.Down := 40;
    Keys.Right := 39;
    Keys.Up := 38;
    Keys.Shoot := 17;
    Color1 := $ff2c2c;
    Color2 := $b60000;
    Enabled := True;
  end;
  with PlayerPool.AddNew do begin
    Name := SRed;
    Keys.Left := 76;
    Keys.Down := 147;
    Keys.Right := 222;
    Keys.Up := 80;
    Keys.Shoot := 191;
    Color1 := $0000ff;
    Color2 := $0000a0;
  end;
  with PlayerPool.AddNew do begin
    Name := SPink;
    Keys.Left := 100;
    Keys.Down := 98;
    Keys.Right := 102;
    Keys.Up := 104;
    Keys.Shoot := 105;
    Color1 := $ff2cff;
    Color2 := $b600b6;
  end;
  with PlayerPool.AddNew do begin
    Name := SCyan;
    Keys.Left := 0;
    Keys.Down := 0;
    Keys.Right := 0;
    Keys.Up := 0;
    Keys.Shoot := 0;
    Color1 := $ffff2c;
    Color2 := $b6b600;
  end;
  with PlayerPool.AddNew do begin
    Name := SYellow;
    Keys.Left := 0;
    Keys.Down := 0;
    Keys.Right := 0;
    Keys.Up := 0;
    Keys.Shoot := 0;
    Color1 := $2cffff;
    Color2 := $00b6b6;
  end;
  with PlayerPool.AddNew do begin
    Name := SOrange;
    Keys.Left := 0;
    Keys.Down := 0;
    Keys.Right := 0;
    Keys.Up := 0;
    Keys.Shoot := 0;
    Color1 := $008cff;
    Color2 := $002da0;
  end;
  with PlayerPool.AddNew do begin
    Name := SGray;
    Keys.Left := 0;
    Keys.Down := 0;
    Keys.Right := 0;
    Keys.Up := 0;
    Keys.Shoot := 0;
    Color1 := $d0d0d0;
    Color2 := $707070;
  end;
  for I := 0 to PlayerPool.Count - 1 do
  with PlayerPool[I] do begin
    Engine := Self;
    Id := I;
    InitTanks;
    if I < 2 then Enabled := True;
  end;
end;

procedure TEngine.InitPlayers;
var
  I: Integer;
  NewPlayer: TPlayer;
begin
  Players.Clear;
  for I := 0 to PlayerPool.Count - 1 do
  with PlayerPool[I] do
  if Enabled then begin
    NewPlayer := TPlayer.Create;
    NewPlayer.Assign(PlayerPool[I]);
    Players.Add(NewPlayer);
    Score := 0;
    World.Matters[Integer(miPlayer1Cannon) + I * 4].Color := clYellow;
    World.Matters[Integer(miPlayer1Home) + I * 4].Color := Color1;
    World.Matters[Integer(miPlayer1TankBody) + I * 4].Color := Color1;
    World.Matters[Integer(miPlayer1TankBody2) + I * 4].Color := Color2;
  end;
end;

procedure TEngine.CheckGameEnd;
var
  I: Integer;
begin
  if Players.GetAliveCount <= 1 then begin
    for I := 0 to Players.Count - 1 do
    with Players[I] do
      if not Exploded then Inc(Score);
    if CurrentRound < MaxRound then begin
      Inc(CurrentRound);
      NewRound;
      State := gsNewRound;
    end else
      State := gsMap;
      if Assigned(FOnGameEnd) then
        FOnGameEnd(Self);
  end;
end;

procedure TEngine.ClearBackground;
begin
  with Bitmap.Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := clBlack;
    FillRect(0, 0, Bitmap.Width, Bitmap.Height);
  end;
end;

procedure TEngine.DrawMenu;
var
  Text: string;
  MenuWidth: Integer;
begin
  with Bitmap.Canvas do begin
    ClearBackground;

    if FShowMenuStats then begin
      MenuWidth := Bitmap.Width div 2;
      DrawStats;
    end else MenuWidth := Bitmap.Width;

    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clWhite;
    Font.Color := clTuna;
    Font.Size := 30;
    Text := 'TUNNELER';
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);

    Font.Color := clDarkOrange;
    Font.Size := 20;
    Text := 'by Chronosoft';
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text);

    Pen.Color := clPurple;
    Pen.Width := 6;
    Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
      (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 200);

    Font.Color := clPurple;
    Font.Size := 20;
    Text := '<F1>  ' + SStartGame;
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);
    Text := '<F2>  ' + SInstructions;
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);
    Text := '<F3>  ' + SInformation;
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);
    Text := '<Alt+F4>  ' + SExit;
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);

    Font.Color := clDarkGreen;
    Font.Size := 20;
    Text := '(' + SWorldReady + ')';
    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
  end;
end;

procedure TEngine.DrawStats;
var
  X: Integer;
  Y: Integer;
  Text: string;
  Winner: TPlayer;
  I: Integer;
  ShotsPercent: Integer;
const
  LineHeight = 40;
begin
  with Bitmap.Canvas do begin
    X := Bitmap.Width div 4 * 3;

    Brush.Style := bsClear;
    Pen.Style := psSolid;

    Pen.Color := clWhite;
    MoveTo(Bitmap.Width div 2, 0);
    LineTo(Bitmap.Width div 2, Bitmap.Height);

    Font.Color := clCyan;
    Font.Size := 20;
    Text := SStatistics;
    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);

    Font.Color := clOrange;
    Font.Size := 20;

    Y := Bitmap.Height div 10 + 3 * LineHeight;
    X := Bitmap.Width div 2 + 50;
    Inc(Y, LineHeight);
    Text := SShotsFired;
    TextOut(X, Y, Text);
    Inc(Y, LineHeight);
    Text := SShotsHit;
    TextOut(X, Y, Text);
    Inc(Y, LineHeight);
    Text := SPercentHit;
    TextOut(X, Y, Text);
    Inc(Y, LineHeight);
    Inc(Y, LineHeight);
    Text := SMetersDug;
    TextOut(X, Y, Text);
    Inc(Y, LineHeight);
    Text := SMetersTravelled;
    TextOut(X, Y, Text);
    Inc(Y, LineHeight);

    for I := 0 to Players.Count - 1 do
    with Players[I] do begin
      Y := Bitmap.Height div 10 + 3 * LineHeight;
      X := Bitmap.Width div 2 + 50 + 500 + 200 * I;
      Font.Color := Color1;
      Text := Name;
      TextOut(X - TextWidth(Text) , Y, Text);
      Inc(Y, LineHeight);
      Text := IntToStr(ShotsCount);
      TextOut(X - TextWidth(Text), Y, Text);
      Inc(Y, LineHeight);
      Text := IntToStr(ShotsHit);
      TextOut(X - TextWidth(Text), Y, Text);
      Inc(Y, LineHeight);
      if ShotsCount > 0 then
        ShotsPercent := Round(ShotsHit / ShotsCount * 100)
        else ShotsPercent := 0;
      Text := IntToStr(ShotsPercent) + '%';
      TextOut(X - TextWidth(Text), Y, Text);
      Inc(Y, LineHeight);
      Inc(Y, LineHeight);
      Text := IntToStr(MetersDug);
      TextOut(X - TextWidth(Text), Y, Text);
      Inc(Y, LineHeight);
      Text := IntToStr(MetersTravelled);
      TextOut(X - TextWidth(Text), Y, Text);
      Inc(Y, LineHeight);
    end;

    Inc(Y, 3 * LineHeight);

    X := Bitmap.Width div 2 + 50;
    Font.Color := clOrange;
    Winner := Players.GetWinner;
    if Assigned(Winner) then begin
      Text := SWinnerIs;
      TextOut(X, Y, Text);
      X := X + TextWidth(Text) + 20;
      Font.Color := Winner.Color1;
      Text := Winner.Name;
      TextOut(X, Y, Text);
    end;
  end;
end;

procedure TEngine.DrawGamePrepare(Thread: TVirtualThread);
var
  I: Integer;
  OldCount: TBitmapTColorIndex;
begin
  Lock.Acquire;
  try
    // TODO: Without this (re)initialization we get range error
    OldCount := FBitmapLower.Count;
    FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
    FBitmapLower.Count := OldCount;

    if FClearBackground then FBitmapLower.FillAll(World.Matters[Integer(miBorder)].Color);
    for I := 0 to Players.Count - 1 do
    if Players[I].Enabled then begin
      Players[I].Paint;
    end;
  finally
    Lock.Release;
  end;
end;

procedure TEngine.ResizePlayerFrames;
var
  HorizFrameCount: Integer;
  VertFrameCount: Integer;
  I: Integer;
begin
  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.Count := FBitmapLower.CreateIndex(PlayerFrameWidth * HorizFrameCount,
      PlayerFrameHeight * VertFrameCount);
    for I := 0 to Players.Count - 1 do begin
      Players[I].ScreenFrame.AsTRect := Rect(
        (I mod HorizFrameCount) * (FBitmapLower.Count.X div HorizFrameCount) + 1,
        (I div HorizFrameCount) * (FBitmapLower.Count.Y div VertFrameCount) + 1,
        ((I mod HorizFrameCount) + 1) * (FBitmapLower.Width div HorizFrameCount),
        ((I div HorizFrameCount) + 1) * (FBitmapLower.Height div VertFrameCount));
    end;
  end;
  FClearBackground := True;
  Redraw;
end;

constructor TEngine.Create(AOwner: TComponent);
begin
  inherited;
  Lock := TCriticalSection.Create;
  FBitmapLower := TBitmapTColor.Create;
  FBitmapLock := TCriticalSection.Create;
  PlayerPool := TPlayers.Create;
  PlayerPool.Engine := Self;
  Players := TPlayers.Create;
  Players.Engine := Self;
  Keyboard := TKeyboard.Create;
  World := TWorld.Create;
  //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);
  AudioShot := TSound.Create(nil);
  AudioShot.FileName := GetCurrentDir + '/Audio/GE_KF7_Soviet.wav';
  AudioExplode := TSound.Create(nil);
  AudioExplode.FileName := GetCurrentDir + '/Audio/bomb.wav';
  InitPlayerPool;
  DigMasks := TObjectList<TMatrixByte>.Create;
  InitDigMasks;
  Redraw;
  MaxRound := 5;
end;

destructor TEngine.Destroy;
begin
  Active := False;
  FreeAndNil(DigMasks);
  FreeAndNil(FBitmapLower);
  FreeAndNil(FBitmapLock);
  FreeAndNil(PlayerPool);
  FreeAndNil(Players);
  FreeAndNil(Keyboard);
  FreeAndNil(World);
  FreeAndNil(Lock);
  FreeAndNil(AudioShot);
  FreeAndNil(AudioExplode);
  inherited;
end;

procedure TEngine.Tick;
var
  I: Integer;
begin
  if State = gsGame then begin
    Lock.Acquire;
    try
      for I := 0 to Players.Count - 1 do begin
        Players[I].Control;
        Players[I].Tick;
      end;
    finally
      Lock.Release;
    end;
  end else
  if State = gsNewRound then begin
    if SecondOf(Now - FStateTime) > NewRoundDelay then begin
      State := gsGame;
    end;
  end;
end;

procedure TEngine.Draw;
var
  DrawStart: TDateTime;
begin
  if FRedrawPending then begin
    DrawStart := NowPrecise;
    FRedrawPending := False;
    case State of
      gsGame: DrawGame;
      gsMenu: DrawMenu;
      gsInformation: DrawInformation;
      gsInstructions: DrawInstructions;
      gsMap: DrawMap;
      gsNewRound: DrawNewRound;
    end;

    DrawDuration := NowPrecise - DrawStart;
  end;
end;

procedure TEngine.DrawThread(Thread: TVirtualThread);
begin
  if State = gsGame then DrawGamePrepare(Thread);
end;

procedure TEngine.NewGame;
var
  I: Integer;
begin
  Active := False;
  InitPlayers;
  ResizePlayerFrames;
  CurrentRound := 1;
  World.Generate;
  for I := 0 to Players.Count - 1 do
    Players[I].Init;
  NewRound;

  Active := True;
end;

procedure TEngine.NewRound;
var
  I: Integer;
begin
  for I := 0 to Players.Count - 1 do
    Players[I].ResetTank;
  FClearBackground := True;
  Redraw;
end;

procedure TEngine.LoadFromRegistry(Context: TRegistryContext);
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Context;
    PlayerPool.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
  finally
    Free;
  end;
end;

procedure TEngine.SaveToRegistry(Context: TRegistryContext);
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Context;

    PlayerPool.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
  finally
    Free;
  end;
end;

procedure TEngine.KeyUp(Key: Word);
const
  KeyF1 = 112;
  KeyF2 = 113;
  KeyF3 = 114;
  KeyF4 = 115;
  KeyEsc = 27;
var
  I: Integer;
begin
  KeyBoard.KeyState[Key] := False;

  if State = gsMenu then begin
    if Key = KeyF1 then begin
      State := gsNewRound;
      NewGame;
    end else
    if Key = KeyF2 then begin
      State := gsInstructions;
    end else
    if Key = KeyF3 then begin
      State := gsInformation;
    end;
  end else
  if State = gsMap then begin
    if Key = KeyEsc then begin
      State := gsMenu;
      FShowMenuStats := True;
    end;
  end else
  if State in [gsInformation, gsInstructions] then begin
    if Key = KeyEsc then begin
      State := gsMenu;
    end;
  end else
  if State = gsGame then begin
     if Key = KeyEsc then begin
       State := gsMap;
     end;
  end;

  {$IFDEF DEBUG}
  if (State = gsGame) and (Key = KeyF4) then begin
    // Destroy first alive player
    for I := 0 to Players.Count - 1 do
    with Players[I] do begin
      if not Exploded then begin
        Energy := -100;
        Break;
      end;
    end;
  end;
  {$ENDIF}
end;

procedure TEngine.KeyDown(Key: Word);
begin
  KeyBoard.KeyState[Key] := True;
end;

end.