There are many CodeProject articles about other card games, but nothing with Schafkopf. So I started to create this article. The first program versions had some unstructured and not reusable code parts and were withdrawn later. Some weeks ago, I decided to make it better and to redesign this project.
Introduction
This article and the demo are about getting started using my Schafkopf_OOP VB.NET project and Schafkopf_Cs C# project.
Background
There are many CodeProject articles about other card games, but nothing with Schafkopf. So I started to create this article.
Using the Code
Here is a Quick Overview
MainWindow Concept and Code
When you start the program, the main window shows a complete deck of cards as a card fan and renders it in a circular panel (based on the above mentioned CodeProject article, Power of Templates in Control Development Within Windows Presentation Foundation including this credit: "I took this panel from the color swatch sample that ships with Microsoft Expression Blend“).
On top of the window, there are some menu items – click on 1. New Game please, then you should see something like that:
MainWindow has the following controls:
- A
Grid with
- a
StackPanel called MyPanel - a
WrapPanel (on top) with the menu items HistoryTextBox for Trick History- Panels for the cards within the
StackPanel called MyPanel Panel0 with ListBox0 on top for player0 = NorthPanel2 with ListBox2 on bottom for player2 = SouthPanel1 with ListBox1 on right side for player1 = EastPanel3 with ListBox3 on left side for player3 = WestPanel4 with ListBox4 is used as TrickHistory (for already played cards)DockPanel CenterPanel
Card Resources and Definitions
The files in folder Resources are taken from [2].
I have changed some things as follows:
- Jacks => Unter => Under (or Sergeant)
- Queens => Ober => Over (or Officer)
- Diamonds => Shells or Ring
- Clubs => Acorn
To keep things easy, I left Spades (which could become "Grass“) as it was.
Class Schafkopf is based on [1].
I have changed the cards deck from 52 to 32 and adjusted the card values and colors as described above.
Putting Things Together - WPF Concept and Code
Shuffle and Distribute Cards
Function CardsDeck.Shuffle is part of the framework [4].
Classes PlayingCard and CircularPanel are taken from Reference [2].
I have added the following properties:
Public Property CardSymbol As StringPublic Property CardShortName As StringPublic Property IsCallAce As BooleanPublic Property IsAlreadyPlayed As BooleanPrivate Shared CardOwnerProperty As DependencyProperty = DependencyProperty.Register("CardOwner", GetType(CardOwner), GetType(PlayingCard), New PropertyMetadata(CardOwner.North))
. . .
When you click on 1. New Game, the ShuffleArray method is started.
After that, the shuffled cards are distributed to the four ListBoxes / CardPanels. This happens via data binding. Sorting HandCards is possible with the framework.
Public Sub NewGame()
processing = True
Me.CircDeck.Children.Clear()
CardsDeck.Reset()
Hand0.Reset()
Hand1.Reset()
Hand2.Reset()
Hand3.Reset()
Hand4.Reset()
If TrickState IsNot Nothing Then TrickState.Reset()
If TrickHistory IsNot Nothing Then TrickHistory.Reset()
CenterPanel.Children.Clear()
iTeamDeclarer = 0
iTeamOpponent = 0
HistoryTextBox.Text = "Trick History: " & Environment.NewLine
sRufAs = ""
RufAs.CardOwner = CType(-1, CardOwner)
RufAs.CardType = -1
sk.iCoSpieler = -1
sk.iGeber = sk.iGeber + 1
If sk.iGeber = 4 Then sk.iGeber = 0
nextMove = sk.iGeber
sk.leadPlayer = sk.iGeber
GameStatus = 2
cbxDeclarer.SelectedIndex = 4
cbxContractSuit.SelectedIndex = 8
PlayCard.IsEnabled = False
labelTrumpLead.Content = " "
labelTrumpcard.Content = "Display for Game Type"
CardsDeck.Shuffle()
Dim cardShuffled As PlayingCard = New PlayingCard()
Dim i As Integer = 0
Dim testValue As Integer = 0
For Each cardShuffled In CardsDeck.Cards
AddHandler cardShuffled.Click, AddressOf card_Click
testValue = i Mod 4
If testValue = 0 Then
cardShuffled.CardOwner = CardOwner.North
Hand0.AddCard(cardShuffled)
End If
If testValue = 1 Then
cardShuffled.CardOwner = CardOwner.East
Hand1.AddCard(cardShuffled)
End If
If testValue = 2 Then
cardShuffled.CardOwner = CardOwner.South
Hand2.AddCard(cardShuffled)
End If
If testValue = 3 Then
cardShuffled.CardOwner = CardOwner.West
Hand3.AddCard(cardShuffled)
End If
i += 1
Next
Hand0.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
Hand0.SortByDescending(CardSortType.KindOnly)
Hand1.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
Hand1.SortByDescending(CardSortType.KindOnly)
Hand2.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
Hand2.SortByDescending(CardSortType.KindOnly)
Hand3.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
Hand3.SortByDescending(CardSortType.KindOnly)
Me.CircDeck.AddHandler(ToggleButton.CheckedEvent,
New RoutedEventHandler(AddressOf OnCardSelected))
CardsDeck.Cards.Clear()
End Sub
Selection of the Declarer and the Game Type
The selection of the declarer and the game type are also human controlled (by the user).
You have to follow the steps as shown in the menu on top.
1. New Game
A click on that menu item starts the CardsDeck.Shuffle method.
After that, the shuffled cards are distributed to the four ListBoxes / CardPanels.
2. Select Declarer
From the combobox on the right of this label, you can select the declarer of the game (who plays a solo or calls an ace).
3. Select GameType
From the combobox on the right of this label, you can select which game type the declarer of the game wants to play – select which solo he wants to play or which ace he wants to call.
Menu item 4. Ready to Play is only active after steps 2. And 3. are completed.
After you clicked it, the Auto Play feature moves a card to the CenterPanel or - if it is the human player's turn – nothing happens until the human player clicked on one of his cards.
The label "Waiting for Card from Player:“ shows whose turn is next.
Place a Card on the CenterPanel
If it is the human player's turn, he can play one of them by clicking on one of his cards.
The clicked card is then automatically moved to the DockPanel CenterPanel.
Private Sub card_Click(ByVal sender As Object, ByVal e As System.EventArgs)
Dim ACP As New AutoCardPlay(sk.trumpCard, Me)
Dim cardsPanel As Object = {ListBox0, ListBox1, ListBox2, ListBox3}
Dim hand As HandCards() = {Hand0, Hand1, Hand2, Hand3}
Try
If sender.CardOwner = 2 Then
If processing Then Return
processing = True
If CenterPanel.Children.Count = 4 Or Hand4.Cards.Count = 4 Then
CenterPanel.Children.Clear()
Hand4.Reset()
HistoryTextBox.AppendText(Environment.NewLine &
"-----------------------" & Environment.NewLine)
End If
sender.IsAlreadyPlayed = True
SetCards(TrickState, sender.CardType, sender.CardValue)
Panel2.Children.Remove(sender)
TrickState.AddCard(sender)
Dim cardColor As String
Dim cardValue As String
Dim cardOwner As String
If sender.CardType = 0 Then cardColor = "Ꚛ"
If sender.CardType = 1 Then cardColor = "♥"
If sender.CardType = 2 Then cardColor = "♠"
If sender.CardType = 3 Then cardColor = "Ⴖ"
cardValue = sender.CardValue
If sender.CardValue = 2 Then cardValue = "U"
If sender.CardValue = 3 Then cardValue = "O"
If sender.CardValue = 4 Then cardValue = "K"
If sender.CardValue = 11 Then cardValue = "A"
If sender.CardOwner = 0 Then cardOwner = "North"
If sender.CardOwner = 1 Then cardOwner = "East "
If sender.CardOwner = 2 Then cardOwner = "South"
If sender.CardOwner = 3 Then cardOwner = "West "
If sender.CardType = RufAs.CardType
AndAlso sender.CardShortName = "A" Then
If GameModus = GameMode.AssenSpiel Then
RufAs.IsAlreadyPlayed = True
RufAs.CardOwner = CType(2, CardOwner)
iCoSpieler = 2
End If
End If
If GameModus <> GameMode.AssenSpiel Then
RufAs.CardOwner = CType(-1, CardOwner)
End If
HistoryTextBox.AppendText(Environment.NewLine &
cardOwner & ": " & cardColor & " " & cardValue)
sender.IsAlreadyPlayed = True
If sender.CardOwner = 2 Then Hand2.RemoveCard(sender)
Hand4.AddCard(CType(sender, UIElement))
System.Windows.Forms.Application.DoEvents()
System.Threading.Thread.Sleep(250)
TrickHistory.PrevCard4 = "Unknown"
If totalMove Mod 4 = 0 Then TrickHistory.PrevCard1 = TrickState.Card1
If totalMove Mod 4 = 0 Then TrickHistory.PrevCard2 = TrickState.Card2
If totalMove Mod 4 = 0 Then TrickHistory.PrevCard3 = TrickState.Card3
If totalMove Mod 4 = 0 Then
If TrickState.Card4 IsNot Nothing Then
TrickHistory.PrevCard4 = TrickState.Card4
End If
If totalMove Mod 4 = 1 Then
TrickState.Card1 = cardValue.ToString & " " & cardColor
TrickState.Card2 = Nothing
TrickState.Card3 = Nothing
TrickState.Card4 = Nothing
TrickState.PlayerIdCard2 = -1
TrickState.PlayerIdCard3 = -1
TrickState.PlayerIdCard3 = -1
SetCardsProps(sender)
End If
If totalMove Mod 4 = 2 Then TrickState.Card2 = cardValue.ToString &
" " & cardColor
If totalMove Mod 4 = 3 Then TrickState.Card3 = cardValue.ToString &
" " & cardColor
If totalMove Mod 4 = 0 Then TrickState.Card4 = cardValue.ToString &
" " & cardColor
If totalMove Mod 4 = 1 Then TrickState.PlayerIdCard1 = nextMove
If totalMove Mod 4 = 2 Then TrickState.PlayerIdCard2 = nextMove
If totalMove Mod 4 = 3 Then TrickState.PlayerIdCard3 = nextMove
If totalMove Mod 4 = 0 Then TrickState.PlayerIdCard4 = nextMove
If totalMove Mod 4 = 1 Then
sWenz = ""
sOber = ""
If sender.CardValue = 2 Or sender.CardValue = 3 Then
If sk.trumpCardSuit <> "Wenz" Then
If totalMove Mod 4 = 1 Then sk.leadSuit = sk.trumpCard
End If
Else
sk.leadSuit = sender.CardType
End If
If sender.CardValue = 2 Then
If sk.trumpCardSuit = "Wenz" Then
If totalMove Mod 4 = 1 Then sk.leadSuit = sk.trumpCard
End If
Else
If sk.trumpCardSuit = "Wenz" Then sk.leadSuit = sender.CardType
End If
labelTrumpLead.Content = "Trump or Lead: " &
sk.suitRows(sk.leadSuit)
End If
hand(nextMove).GetTeam(hand(nextMove), Me)
hand(nextMove).IsTrickOur(hand(nextMove), Me)
nextMove = (nextMove + 1) Mod 4
updateTurnToMoveMessage(nextMove)
If totalMove Mod 4 = 0 Then
tally()
For Each card As PlayingCard In TrickState.Cards
card.IsAlreadyPlayed = True
TrickHistory.AddCard(card)
Next
GetPlayedTrumpsCount(TrickHistory, sk.trumpCard)
TrickState.Reset()
TrickState.CurrentTrickWinner = -2
GameStatus = GameState.FirstCardInTrick
System.Threading.Thread.Sleep(500)
Else
GameStatus = GameState.AnotherCardInTrick
End If
totalMove += 1
For i = 0 To 3
If GameStatus.ToString = "SpielAus" Then Exit Sub
If nextMove = 2 Then
processing = False
If nextMove = 2 Then Exit Sub
Else
If nextMove = i Then ACP.SelectCard(hand(nextMove), nextMove,
sk.declarer, GameStatus,
cardsPanel(nextMove),
sk.trumpCard, Nothing, Me,
sk.leadSuit)
If nextMove = i Then If i > 0 Then
GameStatus = GameState.AnotherCardInTrick
End If
Next
processing = False
End If
Catch ex As Exception
MessageBox.Show(String.Format("{0}{1}", Environment.NewLine, ex.ToString()))
Debug.Print(String.Format("{0}{1}", Environment.NewLine, ex.ToString()))
End Try
End Sub
If it is the auto player's turn, the Public Sub AutoPlaceCardOnTable method does something similar like the Sub card_Click.
At the end of this method:
ACP.SelectCard(hand(nextMove), nextMove, sk.declarer, GameStatus,
cardsPanel(nextMove), sk.trumpCard, Nothing, Me, sk.leadSuit)
is called. ACP is a New AutoCardPlay object.
With nextMove, we control whose turn it is to play a card.
In Sub SelectCard, we make a difference between the first card of a trick and the other cards of a trick.
For the first card of a trick, the methods SelectBestFirstCard and WenzBestFirstCard are relevant.
For the other cards of a trick, the method SelectBestReturnCard is normally used.
These methods may call other Functions or Subs like:
OptimizeSelectionPlayTogether_WenzUsage
- and many others which may appear later when the Game Logic will be presented.
Often used method is IsCardLower which is very important for comparing values of cards. The original version was taken from [7]. It uses a special card value rating method for Schafkopf.
At the end of the SelectCard method, we use the following code:
If FindCard IsNot Nothing Then
CardsPanel.ItemsSource.Remove(FindCard)
Wnd.AutoPlaceCardOnTable(FindCard, PlayerID)
End If
to remove the CurrentCard from the players CardsPanel and call the AutoPlaceCardOnTable method again to move the CurrentCard to the CenterPanel and go on with Auto Play.
Auto Play Feature
At the end of:
Public Sub AutoPlaceCardOnTable
. . .
. . .
Dim cardsPanel As Object = {ListBox0, ListBox1, ListBox2, ListBox3}
Dim hand As HandCards() = {Hand0, Hand1, Hand2, Hand3}
For i = 0 To 3
If GameStatus.ToString = "SpielAus" Then Exit Sub
If nextMove = 2 Then
If nextMove = 2 Then Exit Sub
Else
If nextMove = i Then ACP.SelectCard(hand(nextMove), nextMove, sk.declarer,
GameStatus, cardsPanel(nextMove), sk.trumpCard, Nothing, Me, sk.leadSuit)
If nextMove = i Then If i > 0 Then GameStatus = GameState.AnotherCardInTrick
End If
Next
We take a break If nextMove = 2 (this means Human Player needs to place a card) or run ACP.SelectCard again if nextMove <> 2.
We stop the game on If GameStatus.ToString = "SpielAus".
Implementing Schafkopf Rules
The following code from AutoCardPlay shows how we get a good structure and reusable rules:
#Region "Trump is played, not First Card in Trick"
If LeadSuitID = TrumpID Then
hc.GetTeam(hc, Wnd)
hc.IsTrickOur(hc, Wnd)
If hc.GetHandTrumpCount(hc, TrumpID) > 0 Then
If Wnd.TrickState.CountCardsInTrick = 3 And hc.TrickIsOur Then
If GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
FindCard = GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID)
Else
If GetSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
FindCard = GetSchmear_ALL(hc, LeadSuitID, TrumpID)
End If
End If
ElseIf tc.GetWinnerCard.IsHighestPlayableTrumpCard = True _
And hc.TrickIsOur = True Then
If GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
FindCard = GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID)
End If
ElseIf Wnd.TrickState.CountCardsInTrick = 3 _
And hc.TrickIsOur = False Then
If hc.GetHandNextHigherTrumpCard(TrumpID,
Wnd.TrickState.GetWinnerCard,
Wnd) IsNot Nothing Then
FindCard = hc.GetHandNextHigherTrumpCard(TrumpID,
Wnd.TrickState.GetWinnerCard, Wnd)
End If
ElseIf Wnd.TrickState.GetPointsInTrick > 9 And
Wnd.TrickState.CountCardsInTrick < 3 Then
If GetHighestCard(hc, TrumpID, TrumpID) IsNot Nothing Then
If tc.IsCardLower(tc.GetWinnerCard, GetHighestCard(hc, TrumpID,
TrumpID)) Then
FindCard = GetHighestCard(hc, TrumpID, TrumpID)
End If
End If
End If
If FindCard Is Nothing And hc.TrickIsOur = False Then
If hc.GetHandNextHigherTrumpCard(TrumpID,
Wnd.TrickState.GetWinnerCard,
Wnd) IsNot Nothing Then
FindCard = hc.GetHandNextHigherTrumpCard(TrumpID,
Wnd.TrickState.GetWinnerCard, Wnd)
End If
End If
End If
If FindCard Is Nothing Then
If GetLowTrumpCard(hc, LeadSuitID, TrumpID) IsNot Nothing Then
If tc.IsCardLower(tc.GetWinnerCard, GetLowTrumpCard(hc, LeadSuitID,
TrumpID)) Then
FindCard = GetLowTrumpCard(hc, LeadSuitID, TrumpID)
End If
If FindCard Is Nothing Then FindCard = GetLowTrumpCard(hc,
LeadSuitID,
TrumpID)
End If
End If
End If
#End Region
We can see that:
TrickIsOur Property (which is dependent from Property CurrentTrickWinner; both are in class TrickContent)GetPointsInTrick PropertyCountCardsInTrick PropertyIsCardLower method
and some more are needed.
The first check is if the first card of the trick is a trump or a card of another color.
Case trump is played it is good to know how many cards are already in the current trick – case of 3 we get two variants with TrickIsOur = False or true.
The next case is to return a high card if the trick content value is 10 or more points.
In these three cases, we use methods GetTrumpSchmear_ALL, GetHandNextHigherTrumpCard and GetHighestCard to find a possible return card – in one case, combined with method IsCardLower.
The other cases are needed if less than 3 cards are in the current trick.
Used methods are GetLowestCard or again GetHighestCard.
The used Functions are mainly located in the Extension Modules like AllPlayers which has a high number of methods.
Similar code is needed for #Region "Other Color than trump is played".
The third variant is #Region " LeadSuit n.a. => check for trump (with OR without U or O)".
These three code regions were all inspired by [6].
Teams and class HandCards
It is important to know to which team the current player belongs and who is the current winner of the current trick.
We get this info with:
hc.GetTeam(hc, Wnd)
hc.IsTrickOur(hc, Wnd)
from HandCards.
Public Sub GetTeam(hc As HandCards, Wnd As MainWindow)
If hc.HasCard(Wnd.RufAs.CardValue, Wnd.RufAs.CardType) Then
If Wnd.GameModus = GameMode.AssenSpiel _
And Wnd.RufAs.CardOwner = -1 Then
Wnd.RufAs.CardOwner = CType(PlayerID, CardOwner)
End If
End If
If hc.PlayerID <> Wnd.sk.declarer And hc.PlayerID <> Wnd.iCoSpieler And
Wnd.RufAs.CardOwner <> hc.PlayerID Then
_TeamDeclarer = False
_TeamOpponent = True
End If
If Wnd.RufAs.CardOwner = hc.PlayerID Or hc.PlayerID = Wnd.sk.declarer Or
hc.PlayerID = Wnd.iCoSpieler Then
_TeamOpponent = False
_TeamDeclarer = True
End If
HandIsInTeamDeclarer = _TeamDeclarer
HandIsInTeamOpponent = _TeamOpponent
End Sub
Public Sub IsTrickOur(hc As HandCards, Wnd As MainWindow)
If HandIsInTeamDeclarer = True Then
If Wnd.TrickState.CurrentTrickWinner = Wnd.sk.declarer Or
Wnd.TrickState.CurrentTrickWinner = Wnd.iCoSpieler Or
Wnd.TrickState.CurrentTrickWinner = Wnd.RufAs.CardOwner Then
TrickIsOur = True
Else
TrickIsOur = False
End If
End If
If HandIsInTeamOpponent = True Then
If Wnd.TrickState.CurrentTrickWinner <> Wnd.sk.declarer And
Wnd.TrickState.CurrentTrickWinner <> Wnd.iCoSpieler And
Wnd.TrickState.CurrentTrickWinner <> Wnd.RufAs.CardOwner Then
TrickIsOur = True
Else
TrickIsOur = False
End If
End If
End Sub
More Game Rules
Many of the "rules" are done with "If, Then, ElseIf ..." statements.
Public Function SelectBestFirstCard(ByVal CardsPanel As Object, PlayerID As Integer,
DeclarerID As Integer, GameStatus As Object,
sHandCards As Object, TrumpID As Integer,
hand As HandCards, Wnd As MainWindow,
LeadSuitID As Integer) As PlayingCard
Dim sk As New Schafkopf
Dim FindCard As PlayingCard
If hand Is Nothing Then MessageBox.Show("AutoCardPlay *** hand Is Nothing")
hc = hand
If Wnd.GameOver = True Then Exit Function
If GameStatus.ToString = "SpielAus" Then Wnd.GameOver = True
If GameStatus.ToString = "SpielAus" Then Exit Function
With CardsPanel.Items
If .Count > 0 AndAlso hc.HandIsInTeamDeclarer = True Then
If sHandCards.ToString.Contains("A") = True AndAlso
DeclarerID = PlayerID Then
If Wnd.iTricks = 6 Or Wnd.iTricks = 7 Or Wnd.iTricks = 8 Then
If FindCardByKind(hc, 11) IsNot Nothing Then
If FindCardByKind(hc, 11).CardType = LeadSuitID Then
FindCard = FindCardByKind(hc, 11)
End If
End If
End If
Else
If hc.GetHighestCard(LeadSuitID, TrumpID) IsNot Nothing And
hc.GetHandTrumpCount(hc, TrumpID) > 1 Then
FindCard = hc.GetHighestCard(LeadSuitID, TrumpID)
End If
End If
End If
If .Count > 0 AndAlso hc.HandIsInTeamDeclarer = True Then
If SelectFirstCardTrumpCheck_TD(hc, Wnd, CardsPanel, TrumpID,
LeadSuitID) IsNot Nothing Then
FindCard = SelectFirstCardTrumpCheck_TD(hc, Wnd, CardsPanel,
TrumpID, LeadSuitID)
End If
End If
If hc.HandIsInTeamOpponent = True Then
If SelectFirstCardCallAceCheck_TO(hc, Wnd, CardsPanel, TrumpID,
LeadSuitID) IsNot Nothing Then
FindCard = SelectFirstCardCallAceCheck_TO(hc, Wnd, CardsPanel,
TrumpID, LeadSuitID)
If FindCard IsNot Nothing Then LeadSuitID = FindCard.CardType
End If
End If
End With
If FindCard Is Nothing Then Debug.Print("ACP 304 FindCard Is Nothing")
If CaseFindFirstCardIsNothing(hc, Wnd, CardsPanel, TrumpID,
LeadSuitID) IsNot Nothing Then
FindCard = CaseFindFirstCardIsNothing(hc, Wnd, CardsPanel,
TrumpID, LeadSuitID)
End If
Return FindCard
End Function
Other methods use Linq which is easier to read and understand:
<Extension()>
Public Function FindCardByKind(hand As HandCards, i As Integer) As PlayingCard
If i > 0 Then
If hand.Cards _
.OrderBy(Function(card) card.CardValue) _
.Where(Function(card) card.CardValue = CType(i, CardValue)) _
.Where(Function(card) card.CardType <> hand.TrumpID) _
.FirstOrDefault IsNot Nothing Then
Return hand.Cards _
.OrderBy(Function(card) card.CardValue) _
.Where(Function(card) card.CardValue = CType(i, CardValue)) _
.Where(Function(card) card.CardType <> hand.TrumpID) _
.FirstOrDefault
End If
Else
Return Nothing
End If
End Function
TrickContent is a very important class (based on [7]) which we need for using method IsCardLower or getting IsTrickOur.
IsCardLower compares newCardA.GetCardValue and newCardB.GetCardValue with the usage of a special rating method for the CardValue – see code in class PlayingCard Function GetCardValue. Rating method is based on project [7].
Public Class TrickContent : Inherits ObservableObject
Public Property Card1 As String
Public Property Card2 As String
Public Property Card3 As String
Public Property Card4 As String
Public Property WenzAs1stCard As Integer
Public Property CurrentTrickWinner As Integer
Public Property PlayerIdCard1 As Integer
Public Property PlayerIdCard2 As Integer
Public Property PlayerIdCard3 As Integer
Public Property PlayerIdCard4 As Integer
Public Property PrevCard1 As String
Public Property PrevCard2 As String
Public Property PrevCard3 As String
Public Property PrevCard4 As String
Private _points As Integer
Private _countValue As Integer
Private WinnerIndex As Integer = 0
Private ReadOnly GameType As GameMode
Private ReadOnly TrumpColor As Color
Public Sub New(ByVal gameType As GameMode, ByVal trump As Color,
Optional ByVal startPlayer As Integer = 0)
Me.Cards = New ObservableCollection(Of PlayingCard)
AddHandler Cards.CollectionChanged, AddressOf CardCollectionChanged
Me.GameType = gameType
TrumpColor = trump
End Sub
Public Property GetWinnerCard As PlayingCard
Public ReadOnly Property Cards As ObservableCollection(Of PlayingCard)
Private Sub CardCollectionChanged(sender As Object,
e As NotifyCollectionChangedEventArgs)
OnPropertyChanged(NameOf(Count))
End Sub
Public Sub Reset()
Cards.Clear()
_points = 0
End Sub
Public Sub AddCard(card As PlayingCard)
If Cards.Contains(card) Then
Throw New InvalidOperationException($"Trick already contains card {card}.")
End If
Cards.Add(card)
_countValue = Cards.Count
If _countValue = 0 Then WinnerIndex = -2
If _countValue > 0 Then
CalcWinnerCard(card)
End If
End Sub
Public Sub RemoveCard(card As PlayingCard)
Cards.Remove(card)
End Sub
Public ReadOnly Property CountCardsInTrick As Integer
Get
Return Cards.Count
End Get
End Property
Public ReadOnly Property Count As Integer
Get
Return _countValue
End Get
End Property
Public ReadOnly Property GetPointsInTrick As Integer
Get
_points = 0
For Each card As PlayingCard In Cards
_points += card.GetPoints
Next
Return _points
End Get
End Property
Private Sub CalcWinnerCard(ByVal newCard As PlayingCard)
If _countValue = 1 Then
WinnerIndex = 1
If Cards.Item(_countValue - 1) Is Nothing Then
End If
GetWinnerCard = Cards.Item(0)
CurrentTrickWinner = Cards.Item(0).CardOwner
End If
If _countValue > 1 Then
If IsCardLower(GetWinnerCard, newCard) Then
WinnerIndex = _countValue
GetWinnerCard = newCard
CurrentTrickWinner = newCard.CardOwner
End If
End If
End Sub
Public Function OnePrevCardContainsO() As Boolean
If PrevCard3 IsNot Nothing Then
If PrevCard1.Contains("O") Or PrevCard2.Contains("O") Or
PrevCard3.Contains("O") Or
PrevCard4.Contains("O") Then Return True
End If
Return False
End Function
Public Function IsCardLower(ByVal newCardA As PlayingCard,
ByVal newCardB As PlayingCard) As Boolean
Dim s As GameMode
s = GameMode.Sauspiel
If GameType.ToString = "AssenSpiel" Then s = GameMode.Sauspiel
If GameType.ToString = "Solo" Then s = GameMode.Farbsolo
If GameType.ToString = "Wenz" Then s = GameMode.Wenz
If newCardA IsNot Nothing And newCardB IsNot Nothing Then
If newCardA.GetCardValue(s, TrumpColor,
Me.Cards.Item(0)) < newCardB.GetCardValue(s,
TrumpColor, Me.Cards.Item(0)) Then
Return True
End If
Return False
End If
End Function
End Class
And here is a Sample for an Extension Module which shows the usage of FindCardByKind(hand, 4) to find cards with a certain CardValue or Function SelectFirstCardTrumpCheck_TD which returns a PlayingCard case bPlayHighestTrump is true.
Module TeamDeclarer
Private sO As String
Private sU As String = "U"
<Extension()>
Public Function SelectNextCardCommonCheck_TD(hand As HandCards,
Wnd As MainWindow, ByVal CardsPanel As Object,
TrumpID As Integer, LeadSuitID As Integer) As PlayingCard
Dim FindCard As PlayingCard = Nothing
Dim sHand = hand.GetHandPlayableCardsString(LeadSuitID)
If sHand IsNot Nothing AndAlso Wnd.sRufAs IsNot Nothing Then
If sHand.ToString.Contains(Wnd.sRufAs) Then
If Wnd.GameModus = GameMode.AssenSpiel Then
Wnd.RufAs.CardOwner = CType(hand.PlayerID, CardOwner)
Else
Wnd.RufAs.CardOwner = CardOwner.NONE
End If
End If
End If
If FindCardByKind(hand, 7, 10) IsNot Nothing Then
If FindCardByKind(hand, 7, 10).CardType = LeadSuitID Then
FindCard = FindCardByKind(hand, 7, 10)
End If
End If
If FindCardByKind(hand, 4) IsNot Nothing Then
If FindCardByKind(hand, 4).CardType = LeadSuitID Then
FindCard = FindCardByKind(hand, 4)
End If
End If
If FindCardByKind(hand, 11) IsNot Nothing Then
If FindCardByKind(hand, 11).CardType = LeadSuitID Then
FindCard = FindCardByKind(hand, 11)
End If
End If
If FindCard IsNot Nothing Then Return FindCard
End Function
<Extension()>
Public Function SelectFirstCardTrumpCheck_TD(hc As HandCards,
Wnd As MainWindow,
ByVal CardsPanel As Object,
TrumpID As Integer,
LeadSuitID As Integer) As PlayingCard
If TrumpID = 4 Then sO = "X"
If TrumpID <> 4 Then sO = "O"
Dim FindCard As PlayingCard = Nothing
With CardsPanel.Items
For n = 0 To .Count - 1
If hc.GetHandTrumpCount(hc, TrumpID) > 1 Then
If .Item(n).ToString.Contains(sO) Or
.Item(n).ToString.Contains("U") Then
LeadSuitID = TrumpID
Wnd.sk.leadSuit = TrumpID
If Wnd.bPlayHighestTrump = True Then
Wnd.bPlayHighestTrump = False
FindCard = .Item(n)
Return FindCard
Else
FindCard = .Item(n)
Wnd.bPlayHighestTrump = True
End If
End If
End If
Next
End With
If FindCard IsNot Nothing Then Return FindCard
End Function
End Module
Game UI
If you do not want to see exactly which cards the other players have, enable this code in Mainwindow method updateContract:
After you selected declarer and game type and 4. Ready to Play was pressed, the UI changes.
Cards Tracking and other Details
The related class(es) handle(s) some special cases like a human player would do.
One of them is called AIBase, however technically it is not an AI.
But the results seem to be comparable to an AI which was trained or has learned to play Schafkopf.
For Cards Tracking we are also using class TrickContent with extension Module Extensions_TrickMonitoring
What we are doing like a human player would do is for example:
- Check if a color [suit] was already played in the current game:
Public Function IsLeadSuitPlayedTwice
- Check if the "CallAce" was already played because we want to know if we should take a higher or lower trump:
Public Function IsGetMediumHigherTrumpOk
Public Function IsToSchmearOK
- Public Sub SetCards in Modul Extensions_TrickMonitoring for example is used to get:
PlayingCard Property IsHighestPlayableTrumpCard
Namespace Schafkopf_OOP.aiLogic
Public Class AIBase
#Region "Fields And Properties"
Private iRufAsOwner As Integer
Private tc As TrickContent
'Private TrickSimulate As TrickContent
Private hc As HandCards
#End Region
#Region "Initializations"
Public Sub New(TrumpID As Integer, MyWnd As MainWindow)
tc = MyWnd.TrickState
iRufAsOwner = MyWnd.RufAs.CardOwner
If MyWnd.GameModus = GameMode.Solo Then iRufAsOwner = -1
If MyWnd.GameModus = GameMode.Wenz Then iRufAsOwner = -1
'Debug.Print("AI 35 iRufAsOwner= " & iRufAsOwner.ToString)
End Sub
Private Sub InitHand(ByVal CardsPanel As Object, PlayerID As Integer,
DeclarerID As Integer,
GameStatus As Object,
sHandCards As Object,
TrumpID As Integer,
hc As HandCards,
Wnd As MainWindow,
LeadSuitID As Integer)
With hc
'.TrumpID = TrumpID
'.GetCardTypeInfo(hc, LeadSuitID)
'.GetTeam(hc, Wnd)
End With
End Sub
#End Region
#Region "AI"
Public Function CallAceDownBy(hand As HandCards, suit As Integer,
TrumpCardID As Integer) As PlayingCard
' case the call ace owner has 4 cards with call ace cardType / Color
If TrumpCardID <> 4 And suit <> TrumpCardID Then
If hand.Cards _
.OrderBy(Function(card) card.CardValue) _
.Where(Function(card) card.CardValue > 3) _
.Where(Function(card) card.CardType = suit) _
.FirstOrDefault IsNot Nothing Then
If hand.Cards _
.OrderBy(Function(card) card.CardValue) _
.Where(Function(card) card.CardValue > 3) _
.Where(Function(card) card.CardType = suit) _
.Count > 3 Then
Return hand.Cards _
.OrderBy(Function(card) card.CardValue) _
.Where(Function(card) card.CardValue > 3) _
.Where(Function(card) card.CardType = suit) _
.FirstOrDefault
End If
End If
End If
End Function
Public Function WenzPlayingIsOK(Wnd As MainWindow) As Boolean
If Wnd.TrickHistory.OnePrevCardContainsU = False And
Wnd.TrickHistory.Cards.Item(0).ToString.Contains("U") = False Then
WenzPlayingIsOK = True
Else
WenzPlayingIsOK = False
End If
End Function
Public Function IsLeadSuitPlayedTwice(Wnd As MainWindow,
LeadSuitID As Integer) As Boolean
'IsLeadSuitPlayedTwice = False
If LeadSuitID = 0 AndAlso Wnd.ShellsColor.IsPlayedTwice = True Then Return True
If LeadSuitID = 1 AndAlso Wnd.HeartsColor.IsPlayedTwice = True Then Return True
If LeadSuitID = 2 AndAlso Wnd.SpadesColor.IsPlayedTwice = True Then Return True
If LeadSuitID = 3 AndAlso Wnd.AcornColor.IsPlayedTwice = True Then Return True
Return False
End Function
Public Function IsToSchmearOK(Wnd As MainWindow, hand As HandCards,
suit As Integer, TrumpCardID As Integer) As Boolean
Dim IsSchmearOK As Boolean
'Solo Player Is 1st in trick And plays low trump card with
'CardRatedValue < about 500 Or 550 && opponents still have more than 1 trump
' Info: CardRatedValue Is defined in class PlayingCard
If (tc.CountCardsInTrick = 1 And
Wnd.GameModus = GameMode.Solo And
tc.CurrentTrickWinner = Wnd.sk.declarer And
Wnd.iTricks < 5 And
tc.GetWinnerCard.CardRatedValue < 555) Then
IsSchmearOK = True
ElseIf (tc.CountCardsInTrick > 0 And
Wnd.GameModus = GameMode.AssenSpiel And
tc.CurrentTrickWinner = Wnd.sk.declarer And
tc.GetWinnerCard.IsHighestPlayableTrumpCard = True And
hand.TrickIsOur) Then
IsSchmearOK = True
ElseIf (tc.CountCardsInTrick = 2 And
Wnd.GameModus = GameMode.Solo And
tc.Cards.First().CardOwner = Wnd.sk.declarer And
hand.TrickIsOur) Then
IsSchmearOK = True
ElseIf (tc.CountCardsInTrick = 2 And
Wnd.GameModus = GameMode.Solo And
tc.Cards.First().CardOwner = Wnd.sk.declarer And
tc.GetWinnerCard.CardRatedValue < 550) Then ' hand.TrickIsOur)
IsSchmearOK = True
Else
IsSchmearOK = False
End If
Return IsSchmearOK
End Function
Public Function IsGetMediumHigherTrumpOk(Wnd As MainWindow, tc As TrickContent,
PlayerID As Integer, DeclarerID As Integer) As Boolean
If Wnd.RufAs.IsAlreadyPlayed Or
tc.GetCurrentTrickWinnerCard(Wnd) = tc.Card1 Or
Wnd.GameModus = GameMode.Solo Or Wnd.GameModus = GameMode.Wenz Or
tc.GetWinnerCard.CardOwner = DeclarerID Or tc.CountCardsInTrick > 2 Then
If PlayerID <> DeclarerID Or
tc.GetWinnerCard.CardOwner = DeclarerID Then
Return True
ElseIf tc.CountCardsInTrick > 2 And
tc.GetCurrentTrickWinnerCard(Wnd) <> tc.Card1 Then
Return True
ElseIf PlayerID = DeclarerID And
tc.GetWinnerCard.CardRatedValue < 1000 Then
Return True
ElseIf Wnd.RufAs.IsAlreadyPlayed And hand.TrickIsOur = False Or
Wnd.GameModus = GameMode.Solo And
hand.TrickIsOur = False Or
Wnd.GameModus = GameMode.Wenz And
hand.TrickIsOur = False Or
Wnd.RufAs.IsAlreadyPlayed And
tc.GetWinnerCard.CardRatedValue < 1000 Then
Return True
End If
End If
Return False
End Function
#End Region
End Class
End Namespace
There are much more things which are related to Cards Tracking - explore the source code and you will find it.
I made sure that the computer player doesn't have more information than a human player.
In the current version, the Computer Player is a first-for-all opponent.
It is more important who gets good cards and who gets bad cards.
To get a meaningful result, about 100 games are necessary.
Conclusion
The new Version 3.5 or higher reaches a level like a human player with medium playing level.
The redesign was successful – now the code is better structured and reusable.
This is only a demo – but I think it will allow you to play Schafkopf with / against your computer and have a lot of fun.
Final Note
I am very interested in feedback of any kind - problems, suggestions and other.
Credits / References
History
- 9th February, 2023 - VB Version 3.2
- 11th February, 2023 - VB Version 3.3 fixed some smaller issues
- 16th February, 2023 - VB Version 3.4 fixes most of the known issues
- 21st February, 2023 - C# version: Schafkopf_Cs
- 13th April, 2023 - Source Code Version 3.5 fixes some issues to improve playing quality
- 19th April, 2023 - Source Code Version 3.6 fixes some issues for better playing quality
- 9th February, 2024 - C# Source Code Version 3.8 fixes some important issues for better playing results
- 17th February, 2024 - New chapter in article: Cards Tracking and other Details; C# and VB.Net Source Code Version 4.0 fixes some issues and adds new cards tracking features for better playing results
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
