Changeset 4 for trunk

Timestamp:

Dec 13, 2020, 1:52:47 AM (4 years ago)

Author:

chronos

Message:

• Added: Human and AI player mode.
• Added: Human can select one of offered tokens for movement.

Location:

trunk

Files:

• Games/UClovece.pas (modified) (16 diffs)
• UFormMain.pas (modified) (1 diff)

trunk/Games/UClovece.pas

@@ -25 +25 @@
     MoveCount: Integer;
     Player: TPlayer;
+    Selectable: Boolean;
     property Tile: TTile read FTile write SetTile;
   end;
@@ -35 +36 @@
     function GetSingleByTileKind(Kind: TTileKindSet): TToken;
     procedure GetByTileKind(Kind: TTileKindSet; const Tiles: TTokens);
-  end;
+    procedure GetSelectableTokens(const Tiles: TTokens);
+    function GetSelectableTokensCount: Integer;
+  end;
+
+  TPlayerMode = (pmHuman, pmAI);
 
   { TPlayer }
@@ -46 +51 @@
     StartTile: TTile;
     TileBeforeHome: TTile;
+    Mode: TPlayerMode;
     function CanPlay: Boolean;
     procedure Reset(TokenCount: Integer);
@@ -99 +105 @@
   end;
 
-  TGameState = (gsWaiting, gsRunning, gsGameOver);
+  TGameState = (gsWaiting, gsDiceThrow, gsTokenSelect, gsGameOver);
 
   { TClovece }
@@ -107 +113 @@
     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;
@@ -186 +201 @@
 function TTile.GetNext(Steps: Integer; Player: TPlayer): TTile;
 begin
+  // Self
   Result := nil;
   if Steps > 0 then begin
@@ -191 +207 @@
       Result := NextTileHome.GetNext(Steps - 1, Player)
     end else begin
-      if Assigned(NextTile) then Result := NextTile.GetNext(Steps - 1, Player);
+      if Assigned(NextTile) then Result := NextTile.GetNext(Steps - 1, Player)
+      else begin
+        Result := nil;
+      end;
     end;
   end else Result := Self;
@@ -210 +229 @@
 procedure TTile.Paint(Canvas: TCanvas);
 begin
+  Canvas.Pen.Color := clBlack;
   Canvas.Pen.Width := 5;
   if Assigned(Owner) then Canvas.Brush.Color := Owner.Color
@@ -228 +248 @@
       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
@@ -299 +329 @@
   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;
 
@@ -500 +548 @@
 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;
-  TurnDone: Boolean;
   I: Integer;
   SortedTokens: TTokens;
-begin
-  TurnDone := False;
-  DiceValue := Random(6) + 1;
-  LastDiceValue := DiceValue;
+  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
@@ -528 +705 @@
   end;
   if not TurnDone and (CurrentPlayer.Tokens.GetCountByTileKind([tkNone, tkHome]) > 0) then begin
-    if Assigned(CurrentPlayer.StartTile.Token) and (CurrentPlayer.StartTile.Token.Player = CurrentPlayer) then begin
-      // Own token is on start position, move it away
-      Token := CurrentPlayer.StartTile.Token;
-      NewTile := Token.Tile.GetNext(DiceValue, CurrentPlayer);
-      if not Assigned(NewTile.Token) or (NewTile.Token.Player <> CurrentPlayer) then begin
-        AnimateTokenMovement(Token, NewTile);
-        TurnDone := True;
-      end;
-    end;
-    if not TurnDone then begin
-      SortedTokens := TTokens.Create(False);
-      try
-        CurrentPlayer.Tokens.GetByTileKind([tkNone, tkHome], SortedTokens);
-        SortedTokens.Sort(CompareTokenMoveCount);
-        for I := 0 to SortedTokens.Count - 1 do begin
-          Token := SortedTokens[I];
-          NewTile := Token.Tile.GetNext(DiceValue, CurrentPlayer);
-          if not Assigned(NewTile) then Continue;
-          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
-              Continue;
-            end else begin
-              // Move opponents token back to its yard
-              NewTile.Token.Tile := NewTile.Token.Player.YardTiles.GetTileWithoutToken;
-              AnimateTokenMovement(Token, NewTile);
-              TurnDone := True;
-              Break;
-            end;
-          end else begin
-            // Normal token move
-            AnimateTokenMovement(Token, NewTile);
-            TurnDone := True;
-            Break;
-          end;
-        end;
-      finally
-        SortedTokens.Free;
-      end;
-    end;
   end;
   Inc(DiceThrow);
@@ -580 +717 @@
   end;
   if Players.CanPlayCount < 2 then State := gsGameOver;
+  }
   Repaint;
 end;
 
 procedure TClovece.MouseUp(Button: TMouseButton; Position: TPoint);
-begin
-  if (State = gsRunning) and not Processing then begin
+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;
 
@@ -610 +762 @@
 var
   I: Integer;
+  Player: TPlayer;
 begin
   Players.Clear;
   for I := 0 to PlayerCount - 1 do begin
-    Players.AddNew('Player ' + IntToStr(I + 1), PlayerColors[I]);
+    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);
@@ -622 +776 @@
   DiceValue := -1;
   DiceThrow := 0;
-  State := gsRunning;
+  State := gsDiceThrow;
   Repaint;
 end;
@@ -642 +796 @@
     Board.Paint(MetaCanvas);
     R := MetaCanvas.GetRealRect;
-    MetaCanvas.Move(Point(-R.Left, -R.Top));
+    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 MetaCanvas.Zoom(HeightFactor)
-      else MetaCanvas.Zoom(WidthFactor);
+    if WidthFactor > HeightFactor then Zoom := HeightFactor
+      else Zoom := WidthFactor;
+    MetaCanvas.Zoom(Zoom);
     // Center to window
     R := MetaCanvas.GetRealRect;
-    MetaCanvas.Move(Point((Size.Width - R.Width) div 2, (Size.Height - R.Height) div 2));
+    Shift2 := Point((Size.Width - R.Width) div 2, (Size.Height - R.Height) div 2);
+    MetaCanvas.Move(Shift2);
     MetaCanvas.DrawTo(Canvas);
 

trunk/UFormMain.pas

@@ -114 +114 @@
 procedure TFormMain.FormCreate(Sender: TObject);
 begin
+  Randomize;
   Game := TClovece.Create;
   GameCanvas := TGameCanvas.Create;