~subsetpark/whist

ref: 8fc382a6dce31cc91d6440c69bd07e137b29b63c whist/game/play.janet -rw-r--r-- 6.4 KiB
8fc382a6 — Zach Smith Format all 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
## game/play.janet
(import cards)
(import players)
(import events)
# Play utility logic
## New Suit
(defn- new-suit
  ```
  Determine the led suit in a given trick.

  - If the suit has already been determined, use that.
  - If the card isn't a joker, the led suit is the suit of that card.
  - If the card is a joker :
    - If the bid is notrumps, the led suit hasn't been determined yet.
    - Otherwise, the led suit is the trump suit.
  ```
  [current-suit bid card-played]
  # We need to explicitly set the current suit to `"undefined"`. This
  # allows us to check for the edge case where the suit has
  # not been set, even after a card (or two) has been played
  # - if the first card is a Joker, and it's no trumps.
  (if (not= current-suit "undefined")
    current-suit
    (match [(bid :suit) (card-played :suit)]
      ["notrumps" "joker"] "undefined"
      [trumps "joker"] trumps
      [_ led-suit] led-suit)))

## Total Tricks
(defn- bidding-team
  [players bid]
  ((find |(= ($0 :id) (bid :player)) players) :team))

(defn- non-bidding-team
  [players bid]
  ((find |(not= ($0 :id) (bid :player)) players) :team))

(defn- total-tricks
  [players bid info]
  (let [bidding-team (bidding-team players bid)] 
    (->> (players/of-team players bidding-team)
         (map |(keyword $0 "_tricks"))
         (map |(info $0))
         (sum))))

## Bid Values
(defn- adjustment-for-bid
  ```
  A contract's value is its numerical value, or double its value if it's notrumps.
  ```
  [bid]
  (case (bid :suit)
    "notrumps" |(* $0 2)
    |$0))

(defn- tricks-value
  [total-tricks]
  (- total-tricks 6))

## Made Bid?
(def- score-threshold 7)

(defn- won? [val] (>= val score-threshold))
(defn- lost? [val] (<= val (- score-threshold)))

(defn- made-bid?
  ```
  A team has made a bid if their combined tricks is greater than or equal to their bid + 6.
  ```
  [total-tricks bid]
  (>= total-tricks (+ 6 (bid :count)))) 

# Possible branches of a play state transition
## Continue the Trick
(defn- with-player [card player] (merge-into @{:player player} card))

(defn- continue-trick
  ```
  Handle the first, second or third player playing to a trick.

  Set the led suit if necessary, update the stack and prompt the next player in sequence.
  ```
  [players
   {:meta {:bid current-bid :suit current-suit} :info info}
   current-trick
   just-played]
  (let [new-suit (new-suit current-suit current-bid just-played)
        id-to-prompt (players/next-player (just-played :player) players)
        hand-to-prompt (-> |(= ($0 :id) id-to-prompt)
                           (find players)
                           (in :hand))
        play-prompt (->> (cards/of-suit-or-off new-suit current-bid hand-to-prompt)
                         (events/prompt-play id-to-prompt))]

    [{:phase "play"
      :info info
      :meta {:bid current-bid :suit new-suit}
      :stacks {:trick current-trick}}
     [(events/add-decoration (just-played :player)
                             "play_action"
                             (string "played " (cards/to-text just-played)))
      play-prompt]]))

## Continue the Hand
(defn- continue-hand [events info current-bid winning-player]
  (array/push events (events/prompt-play winning-player))
  # State: Play->Play
  [@{:phase "play"
     :info info
     :meta @{:bid current-bid :suit "undefined"}
     :stacks @{:trick []}}
   events])

## End the Hand
(defn- next-hand [players events info current-bid]
  (let [total-tricks (total-tricks players current-bid info)
        score-multiplier (adjustment-for-bid current-bid)
        bidding-team-keyword (-> players (bidding-team current-bid) (keyword))
        bidders-score (in info bidding-team-keyword)
        bidders-score (if (made-bid? total-tricks current-bid)
                        (+ bidders-score (-> total-tricks (tricks-value) (score-multiplier)))
                        (- bidders-score (-> current-bid (in :count)
                        (score-multiplier) )))
        opponent-team-keyword (-> players (non-bidding-team current-bid) (keyword))
        opponents-score (in info opponent-team-keyword)]
            
    (if (or (won? bidders-score) (lost? bidders-score))
      (array/push events (events/end-game players
                                          bidding-team-keyword
                                          bidders-score
                                          opponent-team-keyword
                                          opponents-score)))
    # State: Play->Deal
    [@{:phase "deal"
       :info {opponent-team-keyword opponents-score
              bidding-team-keyword bidders-score}}
     events]))

## End the Trick
(defn- end-trick
  ```
  Handle the last player playing to a trick.

  Determine which card takes the trick and update: the number of
  tricks taken; if applicable, the team scores.
  ```
  [players state current-trick]
  (let [{:meta {:bid current-bid :suit current-suit}} state
        winning-player (-> current-trick
                           (cards/high-card current-suit current-bid)
                           (in :player))
        events (map |(events/clear-decoration ($0 :id) "play_action") players)
        updated-info (update (state :info) (keyword winning-player "_tricks") inc)]
    (case (length ((players 0) :hand)) 
      # There are no more cards in the players' hands; resolve the
      # current hand. (NB: we expect that the game server will be
      # responsible for updating the hand values on the basis of a
      # `play` prompt.)
      0 (next-hand players events updated-info current-bid)
      (continue-hand events updated-info current-bid winning-player))))

## Main Play Function
(defn- add-to-stack [stack card] (tuple ;stack card))

(defn evaluate-phase
  ```
  Players play to tricks.
  
  In the first trick, the bidder leads; every subsequent trick, the
  winner of the previous trick leads.

  Players must follow suit if possible; if not, they can either
  discard or trump.

  Expected stacks:
  - `trick`: The current trick.
  Expected metadata:
  - `bid`: The current contract.
  - `suit`: The led suit of the current trick.
  ```
  [state players {:player player :value @[card-played]}]
  (let [just-played (with-player card-played player)
        current-trick (-> state
                          (get-in [:stacks :trick])
                          (add-to-stack just-played))]
    (case (length current-trick)
      4 (end-trick players state current-trick)
      (continue-trick players state current-trick just-played))))