source: trunk/Games/UClovece.pas

unit UClovece;

{$mode delphi}

interface

uses
  Classes, SysUtils, Controls, Forms, UGame, fgl, UGraphics, UCanvas;

type
  TPlayer = class;
  TTile = class;
  TTiles = class;

  TTileKind = (tkNone, tkHome, tkYard);
  TTileKindSet = set of TTileKind;

  { TToken }

  TToken = class
  private
    FTile: TTile;
    procedure SetTile(AValue: TTile);
  public
    MoveCount: Integer;
    Player: TPlayer;
    Selectable: Boolean;
    property Tile: TTile read FTile write SetTile;
  end;

  { TTokens }

  TTokens = class(TFPGObjectList<TToken>)
    function AddNew(Player: TPlayer): TToken;
    function GetCountByTileKind(Kind: TTileKindSet): Integer;
    function GetSingleByTileKind(Kind: TTileKindSet): TToken;
    procedure GetByTileKind(Kind: TTileKindSet; const Tiles: TTokens);
    procedure GetSelectableTokens(const Tiles: TTokens);
    function GetSelectableTokensCount: Integer;
  end;

  TPlayerMode = (pmHuman, pmAI);

  { TPlayer }

  TPlayer = class
    Name: string;
    Color: TColor;
    Tokens: TTokens;
    YardTiles: TTiles;
    StartTile: TTile;
    TileBeforeHome: TTile;
    Mode: TPlayerMode;
    function CanPlay: Boolean;
    procedure Reset(TokenCount: Integer);
    constructor Create;
    destructor Destroy; override;
  end;

  { TPlayers }

  TPlayers = class(TFPGObjectList<TPlayer>)
    function AddNew(Name: string; Color: TColor): TPlayer;
    function CanPlayCount: Integer;
  end;

  { TTile }

  TTile = class
  private
    FOwner: TPlayer;
    FToken: TToken;
    procedure SetOwner(AValue: TPlayer);
    procedure SetToken(AValue: TToken);
  public
    Id: Integer;
    Position: TPoint;
    Kind: TTileKind;
    NextTile: TTile;
    NextTileHome: TTile;
    AnimateToken: TToken;
    function GetNext(Steps: Integer; Player: TPlayer): TTile;
    procedure GetNextSteps(Steps: Integer; Player: TPlayer; Tiles: TTiles);
    procedure Paint(Canvas: TCanvas);
    property Owner: TPlayer read FOwner write SetOwner;
    property Token: TToken read FToken write SetToken;
  end;

  { TTiles }

  TTiles = class(TFPGObjectList<TTile>)
    function AddNew(Position: TPoint; Kind: TTileKind; Owner: TPlayer): TTile;
    function GetTileWithoutToken: TTile;
  end;

  { TBoard }

  TBoard = class
    Players: TPlayers;
    Tiles: TTiles;
    procedure Build(PlayerCount, TokenCount: Integer);
    procedure Paint(Canvas: TCanvas);
    constructor Create;
    destructor Destroy; override;
  end;

  TGameState = (gsWaiting, gsDiceThrow, gsTokenSelect, gsGameOver);

  { TClovece }

  TClovece = class(TGame)
  private
    MetaCanvas: TMetaCanvas;
    Processing: Boolean;
    SelectedToken: TToken;
    Zoom: Double;
    Shift1: TPoint;
    Shift2: TPoint;
    TokensMoved: Integer;
    procedure AnimateTokenMovement(Token: TToken; NewTile: TTile);
    function AISelectToken: TToken;
    procedure MoveToken(Token: TToken);
    procedure NextPlayer(SelectableTokenCount: Integer);
    function GetBoardPos(P: TPoint): TPoint;
  public
    Board: TBoard;
    Players: TPlayers;
    CurrentPlayer: TPlayer;
    DiceValue: Integer;
    LastDiceValue: Integer;
    DiceThrow: Integer;
    State: TGameState;
    PlayerCount: Integer;
    TokenCount: Integer;
    procedure ThrowDice;
    procedure MouseUp(Button: TMouseButton; Position: TPoint); override;
    procedure KeyUp(Key: Word); override;
    procedure Reset; override;
    procedure Paint(Canvas: TCanvas); override;
    constructor Create; override;
    destructor Destroy; override;
  end;

const
  TileDistance: Integer = 60;
  TileSize: Integer = 50;
  TokenSize: Integer = 30;
  PlayerColors: array[0..7] of TColor = (clRed, clLightBlue, clYellow, clGreen,
    clFuchsia, clAqua, clBrown, clOrange);


implementation

uses
  UGeometric;

{ TToken }

procedure TToken.SetTile(AValue: TTile);
var
  OldTile: TTile;
begin
  if FTile = AValue then Exit;
  if Assigned(FTile) then begin
    OldTile := FTile;
    FTile := nil;
    OldTile.Token := nil;
  end;
  FTile := AValue;
  if Assigned(FTile) then FTile.Token := Self;
end;

{ TTile }

procedure TTile.SetOwner(AValue: TPlayer);
begin
  if FOwner = AValue then Exit;
  if Assigned(FOwner) then begin
    if Kind = tkYard then FOwner.YardTiles.Remove(Self);
  end;
  FOwner := AValue;
  if Assigned(FOwner) then begin
    if Kind = tkYard then FOwner.YardTiles.Add(Self);
  end;
end;

procedure TTile.SetToken(AValue: TToken);
var
  OldToken: TToken;
begin
  if FToken = AValue then Exit;
  if Assigned(FToken) then begin
    OldToken := FToken;
    FToken := nil;
    OldToken.Tile := nil;
  end;
  FToken := AValue;
  if Assigned(FToken) then FToken.Tile := Self;
end;

function TTile.GetNext(Steps: Integer; Player: TPlayer): TTile;
begin
  // Self
  Result := nil;
  if Steps > 0 then begin
    if Assigned(NextTileHome) and (NextTileHome.Owner = Player) then begin
      Result := NextTileHome.GetNext(Steps - 1, Player)
    end else begin
      if Assigned(NextTile) then Result := NextTile.GetNext(Steps - 1, Player)
      else begin
        Result := nil;
      end;
    end;
  end else Result := Self;
end;

procedure TTile.GetNextSteps(Steps: Integer; Player: TPlayer; Tiles: TTiles);
begin
  if Steps > 0 then begin
    Tiles.Add(Self);
    if Assigned(NextTileHome) and (NextTileHome.Owner = Player) then begin
      NextTileHome.GetNextSteps(Steps - 1, Player, Tiles)
    end else begin
      if Assigned(NextTile) then NextTile.GetNextSteps(Steps - 1, Player, Tiles);
    end;
  end;
end;

procedure TTile.Paint(Canvas: TCanvas);
begin
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 5;
  if Assigned(Owner) then Canvas.Brush.Color := Owner.Color
    else Canvas.Brush.Color := clWhite;
  Canvas.Ellipse(
    Position.X - TileSize div 2,
    Position.Y - TileSize div 2,
    Position.X + TileSize div 2,
    Position.Y + TileSize div 2
  );
  if Assigned(Token) then begin
    Canvas.Pen.Width := 5;
    Canvas.Brush.Color := Token.Player.Color;
    Canvas.Ellipse(
      Position.X - TokenSize div 2,
      Position.Y - TokenSize div 2,
      Position.X + TokenSize div 2,
      Position.Y + TokenSize div 2
    );
    if Token.Selectable then begin
      Canvas.Pen.Color := clBlack;
      Canvas.Ellipse(
        Position.X - TokenSize div 2 + 10,
        Position.Y - TokenSize div 2 + 10,
        Position.X + TokenSize div 2 - 10,
        Position.Y + TokenSize div 2 - 10
      );
      Canvas.Pen.Color := clBlack;
    end;
  end;
  if Assigned(AnimateToken) then begin
    Canvas.Pen.Width := 5;
    Canvas.Brush.Color := AnimateToken.Player.Color;
    Canvas.Ellipse(
      Position.X - TokenSize div 2,
      Position.Y - TokenSize div 2,
      Position.X + TokenSize div 2,
      Position.Y + TokenSize div 2
    );
  end;
end;

{ TTiles }

function TTiles.AddNew(Position: TPoint; Kind: TTileKind; Owner: TPlayer
  ): TTile;
begin
  Result := TTile.Create;
  Result.Id := Count;
  Result.Position := Position;
  Result.Kind :=  Kind;
  Result.Owner := Owner;
  Add(Result);
end;

function TTiles.GetTileWithoutToken: TTile;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and Assigned(Items[I].Token) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

{ TTokens }

function TTokens.AddNew(Player: TPlayer): TToken;
begin
  Result := TToken.Create;
  Result.Player := Player;
  Add(Result);
end;

function TTokens.GetCountByTileKind(Kind: TTileKindSet): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].Tile.Kind in Kind then Inc(Result);
end;

function TTokens.GetSingleByTileKind(Kind: TTileKindSet): TToken;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (not (Items[I].Tile.Kind in Kind)) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

procedure TTokens.GetByTileKind(Kind: TTileKindSet; const Tiles: TTokens);
var
  I: Integer;
begin
  Tiles.Clear;
  for I := 0 to Count - 1 do
    if Items[I].Tile.Kind in Kind then Tiles.Add(Items[I]);
end;

procedure TTokens.GetSelectableTokens(const Tiles: TTokens);
var
  I: Integer;
begin
  Tiles.Clear;
  for I := 0 to Count - 1 do
    if Items[I].Selectable then Tiles.Add(Items[I]);
end;

function TTokens.GetSelectableTokensCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].Selectable then Inc(Result);
end;

{ TPlayers }

function TPlayers.AddNew(Name: string; Color: TColor): TPlayer;
begin
  Result := TPlayer.Create;
  Result.Name := Name;
  Result.Color := Color;
  Add(Result);
end;

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

{ TPlayer }

function TPlayer.CanPlay: Boolean;
begin
  Result := Tokens.GetCountByTileKind([tkYard, tkNone]) > 0;
end;

procedure TPlayer.Reset(TokenCount: Integer);
var
  I: Integer;
begin
  Tokens.Clear;
  for I := 0 to TokenCount - 1 do
    Tokens.AddNew(Self);
  for I := 0 to Tokens.Count - 1 do
    Tokens[I].Tile := YardTiles[I];
end;

constructor TPlayer.Create;
begin
  Tokens := TTokens.Create;
  YardTiles := TTiles.Create(False);
end;

destructor TPlayer.Destroy;
begin
  YardTiles.Free;
  Tokens.Free;
  inherited;
end;

{ TBoard }

procedure TBoard.Build(PlayerCount, TokenCount: Integer);
var
  I: Integer;
  J: Integer;
  Center: TPoint;
  Angle: Real;
  AngleDiff: Real;
  P: TPoint;
  P1, P2: TPoint;
  R: Integer;
  Between: Boolean;
const
  BaseR: array[0..8] of Single = (0, 0, 0.5, 0.6, 1, 1.4, 2.7, 3.4, 4.1);
  DrawBetween: array[0..8] of Boolean = (False, False, True, False, False, False,
    True, True, True);
begin
  R := Trunc(BaseR[PlayerCount] * TileDistance);
  Between := DrawBetween[PlayerCount];
  AngleDiff := 2 * Pi / Players.Count;
  Center := Point(7 * TileDistance, 7 * TileDistance);

  Tiles.Clear;
  for J := 0 to PlayerCount - 1 do begin
    Angle := J * AngleDiff;
    // Normal tiles
    for I := 1 to TokenCount do begin
      P := Point(Center.X + R + I * TileDistance, Center.Y - TileDistance);
      P := RotatePoint(Center, P, Angle);
      Tiles.AddNew(P, tkNone, nil);
      if Tiles.Count >= 2 then Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];
    end;
    P := Point(Center.X + R + TokenCount * TileDistance, Center.Y);
    P := RotatePoint(Center, P, Angle);
    Tiles.AddNew(P, tkNone, nil);
    Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];
    Players[J].TileBeforeHome := Tiles[Tiles.Count - 1];

    // Start
    P := Point(Center.X + R + TokenCount * TileDistance, Center.Y + TileDistance);
    P := RotatePoint(Center, P, Angle);
    Players[J].StartTile := Tiles.AddNew(P, tkNone, Players[J]);
    Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];

    for I := TokenCount - 1 downto 1 do begin
      P := Point(Center.X + R + I * TileDistance, Center.Y + TileDistance);
      P := RotatePoint(Center, P, Angle);
      Tiles.AddNew(P, tkNone, nil);
      Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];
    end;
    // Between
    if Between then begin
      P1 := Point(Center.X + R + TileDistance, Center.Y + TileDistance);
      P1 := RotatePoint(Center, P1, Angle);
      P2 := Point(Center.X + R + TileDistance, Center.Y - TileDistance);
      P2 := RotatePoint(Center, P2, Angle + AngleDiff);
      P := AveragePoint(P1, P2);
    end else begin
      P := Point(Center.X + R, Center.Y + TileDistance);
      P := RotatePoint(Center, P, Angle);
    end;
    Tiles.AddNew(P, tkNone, nil);
    Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];
  end;
  Tiles[Tiles.Count - 1].NextTile := Tiles[0];

  // Homes
  for J := 0 to PlayerCount - 1 do begin
    Angle := J * AngleDiff;
    for I := TokenCount - 1 downto 0 do begin
      P := Point(Center.X + R + I * TileDistance, Center.Y);
      P := RotatePoint(Center, P, Angle);
      Tiles.AddNew(P, tkHome, Players[J]);
      if I = TokenCount - 1 then Players[J].TileBeforeHome.NextTileHome := Tiles[Tiles.Count - 1]
      else Tiles[Tiles.Count - 2].NextTile := Tiles[Tiles.Count - 1];
    end;
  end;

  // Yards
  for J := 0 to PlayerCount - 1 do begin
    Angle := (J + 0.5) * AngleDiff;
    for I := 0 to TokenCount - 1 do begin
      P := Point(Trunc(Center.X + R + TokenCount * TileDistance * 1.35), Center.Y);
      P := RotatePoint(Center, P, Angle);
      Tiles.AddNew(RotatePoint(P, Point(P.X + Trunc(0.7 * TileDistance), P.Y), I / TokenCount * 2 * Pi + Pi / 4), tkYard, Players[J]);
    end;
  end;
end;

procedure TBoard.Paint(Canvas: TCanvas);
var
  I: Integer;
begin
  TileDistance := 60;
  TileSize := 50;
  TokenSize := 30;
  Canvas.Pen.Width := 5;
  for I := 0 to Tiles.Count - 1 do
    if Assigned(Tiles[I].NextTile) then begin
      Canvas.Line(Tiles[I].Position, Tiles[I].NextTile.Position);
    end;
  for I := 0 to Tiles.Count - 1 do
    Tiles[I].Paint(Canvas);
end;

constructor TBoard.Create;
begin
  Tiles := TTiles.Create;
end;

destructor TBoard.Destroy;
begin
  Tiles.Free;
  inherited;
end;

{ TClovece }

procedure TClovece.AnimateTokenMovement(Token: TToken; NewTile: TTile);
var
  I: Integer;
  Steps: TTiles;
begin
  Steps := TTiles.Create(False);
  try
    Token.Tile.GetNextSteps(DiceValue, CurrentPlayer, Steps);
    Token.Tile := nil;
    for I := 0 to Steps.Count - 1 do begin
      Steps[I].AnimateToken := Token;
      Repaint;
      Application.ProcessMessages;
      Sleep(200);
      Steps[I].AnimateToken := nil;
    end;
  finally
    Steps.Free;
  end;
  Token.Tile := NewTile;
  Token.MoveCount := Token.MoveCount + DiceValue;
end;

function CompareTokenMoveCount(const Item1, Item2: TToken): Integer;
begin
  if Item1.MoveCount < Item2.MoveCount then Result := 1
  else if Item1.MoveCount > Item2.MoveCount then Result := -1
  else Result := 0;
end;

function TClovece.AISelectToken: TToken;
var
  Token: TToken;
  Tokens: TTokens;
  SortedTokens: TTokens;
begin
  Tokens := TTokens.Create(False);
  CurrentPlayer.Tokens.GetSelectableTokens(Tokens);
  if Tokens.Count = 0 then begin
  end else
  if Tokens.Count = 1 then begin
    Result := Tokens[0];
  end else begin
    if Tokens.GetCountByTileKind([tkYard]) > 0 then begin
      Result := Tokens.GetSingleByTileKind([tkYard]);
    end else
    if Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player = CurrentPlayer) then begin
      Result := CurrentPlayer.StartTile.Token
    end else begin
      SortedTokens := TTokens.Create(False);
      Tokens.GetByTileKind([tkNone, tkHome], SortedTokens);
      Tokens.Sort(CompareTokenMoveCount);
      Result := Tokens[0];
      SortedTokens.Free;
    end;
    Tokens.Free;
  end;
end;

procedure TClovece.MoveToken(Token: TToken);
var
  NewTile: TTile;
begin
  if Token.Tile.Kind = tkYard then begin
    // Move from yard
    if (not Assigned(CurrentPlayer.StartTile.Token)) or (
    Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player <> CurrentPlayer)) then begin
      if Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player <> CurrentPlayer) then begin
        // Move opponents token back to its yard
        CurrentPlayer.StartTile.Token.Tile := CurrentPlayer.StartTile.Token.Player.YardTiles.GetTileWithoutToken;
      end;
      // Move one token from yard to start
      Token.MoveCount := 0;
      CurrentPlayer.StartTile.Token := Token;
    end;
  end else
  if Token.Tile.Kind in [tkNone, tkHome] then begin
    NewTile := Token.Tile.GetNext(DiceValue, CurrentPlayer);
    if Assigned(NewTile) then begin
      if Assigned(NewTile.Token) then begin
        if NewTile.Token.Player = Token.Player then begin
          // Another own token is blocking way, use another one if possible
        end else begin
          // Move opponents token back to its yard
          NewTile.Token.Tile := NewTile.Token.Player.YardTiles.GetTileWithoutToken;
          AnimateTokenMovement(Token, NewTile);
        end;
      end else begin
        // Normal token move
        AnimateTokenMovement(Token, NewTile);
      end;
    end;
  end;
end;

procedure TClovece.NextPlayer(SelectableTokenCount: Integer);
begin
  if ((SelectableTokenCount = 0) and (DiceThrow >= 3)) or
    ((SelectableTokenCount = 0) and (TokensMoved > 0)) or
    ((SelectableTokenCount > 0) and (DiceValue <> 6)) or
    (CurrentPlayer.Tokens.GetCountByTileKind([tkHome]) = TokenCount) then begin
    repeat
      CurrentPlayer := Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count];
    until CurrentPlayer.CanPlay or (Players.CanPlayCount >= 2);
    DiceThrow := 0;
    DiceValue := -1;
    TokensMoved := 0;
  end;
end;

function TClovece.GetBoardPos(P: TPoint): TPoint;
begin
  Result := SubPoint(P, Shift2);
  Result := Point(Trunc(Result.X / Zoom), Trunc(Result.Y / Zoom));
  Result := SubPoint(Result, Shift1);
end;

procedure TClovece.ThrowDice;
var
  Token: TToken;
  NewTile: TTile;
  I: Integer;
  SortedTokens: TTokens;
  SelectableTokenCount: Integer;
begin
  if State = gsTokenSelect then begin
    if Assigned(SelectedToken) then begin
      SelectableTokenCount := CurrentPlayer.Tokens.GetSelectableTokensCount;
      for I := 0 to CurrentPlayer.Tokens.Count - 1 do
        CurrentPlayer.Tokens[I].Selectable := False;
      MoveToken(SelectedToken);
      State := gsDiceThrow;
      Inc(TokensMoved);
      NextPlayer(SelectableTokenCount);
      SelectedToken := nil;
    end;
  end else
  if State = gsDiceThrow then begin
    DiceValue := Random(6) + 1;
    LastDiceValue := DiceValue;
    Inc(DiceThrow);

    // Select possible tokens for move
    SelectableTokenCount := 0;
    for I := 0 to CurrentPlayer.Tokens.Count - 1 do begin
      Token := CurrentPlayer.Tokens[I];
      Token.Selectable := False;
      if (DiceValue = 6) and (Token.Tile.Kind = tkYard) and (
        not Assigned(CurrentPlayer.StartTile.Token) or
        (Assigned(CurrentPlayer.StartTile.Token) and
        (CurrentPlayer.StartTile.Token.Player <> CurrentPlayer))) then Token.Selectable := True;
      if Token.Tile.Kind in [tkNone, tkHome] then begin
        NewTile := Token.Tile.GetNext(DiceValue, CurrentPlayer);
        if Assigned(NewTile) and
          ((Assigned(NewTile.Token) and (NewTile.Token.Player <> CurrentPlayer)) or
          not Assigned(NewTile.Token)) then Token.Selectable := True;
      end;
      if Token.Selectable then Inc(SelectableTokenCount);
    end;
    if SelectableTokenCount = 0 then begin
      NextPlayer(SelectableTokenCount);
    end else begin
      State := gsTokenSelect;
      if CurrentPlayer.Mode = pmAI then begin
        SelectedToken := AISelectToken;
        ThrowDice;
      end;
    end;
  end;
{
  if DiceValue = 6 then begin
    if CurrentPlayer.Tokens.GetCountByTileKind([tkYard]) > 0 then begin
      if (not Assigned(CurrentPlayer.StartTile.Token)) or (
      Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player <> CurrentPlayer)) then begin
        if Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player <> CurrentPlayer) then begin
          // Move opponents token back to its yard
          CurrentPlayer.StartTile.Token.Tile := CurrentPlayer.StartTile.Token.Player.YardTiles.GetTileWithoutToken;
        end;
        // Move one token from yard to start
        Token := CurrentPlayer.Tokens.GetSingleByTileKind([tkYard]);
        Token.MoveCount := 0;
        CurrentPlayer.StartTile.Token := Token;
        TurnDone := True;
      end;
    end;
  end;
  if not TurnDone and (CurrentPlayer.Tokens.GetCountByTileKind([tkNone, tkHome]) > 0) then begin
  end;
  Inc(DiceThrow);
  if ((CurrentPlayer.Tokens.GetCountByTileKind([tkNone]) = 0) and (DiceThrow >= 3)) or
    ((CurrentPlayer.Tokens.GetCountByTileKind([tkNone]) > 0) and (DiceValue <> 6)) or
    (CurrentPlayer.Tokens.GetCountByTileKind([tkHome]) = TokenCount) then begin
    repeat
      CurrentPlayer := Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count];
    until CurrentPlayer.CanPlay or (Players.CanPlayCount >= 2);
    DiceThrow := 0;
    DiceValue := -1;
  end;
  if Players.CanPlayCount < 2 then State := gsGameOver;
  }
  Repaint;
end;

procedure TClovece.MouseUp(Button: TMouseButton; Position: TPoint);
var
  I: Integer;
  Tile: TTile;
  BoardPos: TPoint;
begin
  BoardPos := GetBoardPos(Position);
  for I := 0 to Board.Tiles.Count - 1 do begin
    Tile := Board.Tiles[I];
    if Assigned(Tile.Token) and Tile.Token.Selectable and
      (Distance(Tile.Position, BoardPos) < (TileSize div 2)) then begin
      SelectedToken := Board.Tiles[I].Token;
      Break;
    end;
  end;
  if (State in [gsDiceThrow, gsTokenSelect]) and not Processing then begin
    Processing := True;
    ThrowDice;
    Processing := False;
  end;
  Repaint;
end;

procedure TClovece.KeyUp(Key: Word);
const
  KeyQ = 81;
  KeyW = 87;
begin
  if Key = KeyQ then begin
    if PlayerCount < 8 then Inc(PlayerCount);
    Reset;
  end;
  if Key = KeyW then begin
    if PlayerCount > 2 then Dec(PlayerCount);
    Reset;
  end;
end;

procedure TClovece.Reset;
var
  I: Integer;
  Player: TPlayer;
begin
  Players.Clear;
  for I := 0 to PlayerCount - 1 do begin
    Player := Players.AddNew('Player ' + IntToStr(I + 1), PlayerColors[I]);
    //if I > 0 then Player.Mode := pmAI else Player.Mode := pmHuman;
  end;
  Board.Build(Players.Count, TokenCount);
  for I := 0 to Players.Count - 1 do begin
    Players[I].Reset(TokenCount);
  end;
  CurrentPlayer := Players.First;
  DiceValue := -1;
  DiceThrow := 0;
  State := gsDiceThrow;
  Repaint;
end;

procedure TClovece.Paint(Canvas: TCanvas);
var
  R: TRect;
  WidthFactor: Double;
  HeightFactor: Double;
begin
  with Canvas do begin
    Pen.Color := clBlack;
    Brush.Opacity := $ff;
    Brush.Color := clGray;
    Brush.Style := bsSolid;
    Rectangle(Rect(0, 0, Size.Width, Size.Height));

    MetaCanvas.Reset;
    Board.Paint(MetaCanvas);
    R := MetaCanvas.GetRealRect;
    Shift1 := Point(-R.Left, -R.Top);
    MetaCanvas.Move(Shift1);
    // Scale to window size
    WidthFactor := Size.Width / R.Width / 1.05;
    HeightFactor := Size.Height / R.Height / 1.05;
    if WidthFactor > HeightFactor then Zoom := HeightFactor
      else Zoom := WidthFactor;
    MetaCanvas.Zoom(Zoom);
    // Center to window
    R := MetaCanvas.GetRealRect;
    Shift2 := Point((Size.Width - R.Width) div 2, (Size.Height - R.Height) div 2);
    MetaCanvas.Move(Shift2);
    MetaCanvas.DrawTo(Canvas);

    Brush.Opacity := 0;
    Pen.Color := clBlack;
    Brush.Style := bsSolid;
    Brush.Color := CurrentPlayer.Color;
    TextOut(Point(0, 0), 'Player: ' + CurrentPlayer.Name);
    Brush.Style := bsClear;
    TextOut(Point(0, 30), 'Dice: ' + IntToStr(DiceValue) + ' ' + IntToStr(LastDiceValue));
    TextOut(Point(0, 60), 'Throw: ' + IntToStr(DiceThrow));
  end;
end;

constructor TClovece.Create;
begin
  inherited;
  MetaCanvas := TMetaCanvas.Create;
  Players := TPlayers.Create;
  Board := TBoard.Create;
  Board.Players := Players;
  PlayerCount := 4;
  TokenCount := 4;
end;

destructor TClovece.Destroy;
begin
  Board.Free;
  Players.Free;
  MetaCanvas.Free;
  inherited;
end;

end.