~subsetpark/whist

71608b9f59ce5fe0d90bda0f928992079187bde4 — Zach Smith 11 months ago b419742
Handle tracking of player tricks and team scores
7 files changed, 182 insertions(+), 81 deletions(-)

M events.janet
M game/discard.janet
M game/play.janet
M init.janet
M test/last-card.janet
M test/lead.janet
M test/whist.janet
M events.janet => events.janet +2 -0
@@ 3,3 3,5 @@
(defn draw [player count] {:event "draw" :player player :count count})

(defn add-decoration [player name value] {:event "add_decoration" :name name :player player :value value})

(defn clear-decoration [player name] {:event "clear_decoration" :name name :player player})

M game/discard.janet => game/discard.janet +3 -3
@@ 1,8 1,8 @@
(import events)
(import bids)

(defn- make-full-bid [high-bid second-bid]
  (merge high-bid second-bid))
(defn- make-full-bid [high-bid second-bid bidder]
  (merge high-bid second-bid {:player bidder}))

(defn discard-phase
  ```


@@ 16,7 16,7 @@
  - `bid`: The full bid for the hand. 
  ```
  [{:meta {:high_bid {:bid high-bid}}} {:player bidder :value second-bid}]
  (let [full-bid (make-full-bid high-bid second-bid)
  (let [full-bid (make-full-bid high-bid second-bid bidder)
	full-bid-text (string (bids/to-text high-bid) ": " (bids/to-text second-bid bids/second-bids))] 
       # State: Discard -> Begin Play
       [{:phase "begin_play" :meta {:bid full-bid}}

M game/play.janet => game/play.janet +106 -38
@@ 15,6 15,10 @@
    - Otherwise, the led suit is the trump suit.
  ```
  [current-suit bid card-played]
  # We need to explicitly set the current suit to null. 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 :null)
    current-suit
    (match [(bid :suit) (card-played :suit)]


@@ 25,6 29,102 @@
(defn- prompt-play [player from]
  {:event "prompt_play" :player player :to "trick" :count 1 :from from})

(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- made-bid?
  [players bid info]
  ```
  A team has made a bid if their combined tricks is greater than or equal to their bid + 6.
  ```
  (let [bidding-team (bidding-team players bid) 
	total-tricks (->> players
			  (filter | (= ($0 :team) bidding-team))
			  (map | ($0 :id))
			  (map | (keyword $0 "_tricks"))
			  (map | (info $0))
			  (map | ($0 :value))
			  (sum))]
    (>= total-tricks (+ 6 (bid :count))))) 

(defn- contract-value
  [bid]
  ```
  A contact's value is its numerical value, or double its value if it's notrumps.
  ```
  (case (bid :suit)
    "notrumps" (* (bid :count) 2)
    (bid :count)))
 
(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 state current-trick current-bid just-played]
  (let [old-meta (state :meta)
	current-suit (old-meta :suit)
	player (just-played :player)
	new-suit (new-suit current-suit current-bid just-played)
	id-to-prompt (players/next-player player players)
	player-to-prompt (find |(= ($0 :id) id-to-prompt) players)
	prompt-choices (cards/of-suit-or-off new-suit current-bid (player-to-prompt :hand))]

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

(defn- end-trick [players state current-trick current-bid just-played]
  ```
  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.
  ```
  (let [apply-ordering (cards/apply-ordering current-bid)
	full-trick (array ;current-trick just-played)
	with-compare (map apply-ordering full-trick) 
	current-suit (get-in state [:meta :suit])
	highest (cards/high-card current-suit (current-bid :suit) ;with-compare)
	highest-player (highest :player)
	events (map |(events/clear-decoration ($0 :id) "play_action") players)]

    (var new-trick-state @{:info (state :info)
			   :meta @{:bid current-bid}
			   :stacks @{:trick []}})
    (update-in new-trick-state [:info (keyword highest-player "_tricks") :value] 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 (let [score-value (contract-value current-bid)
	      opponents (-> players (non-bidding-team current-bid) (keyword))
	      opponents-score (get-in state [:info opponents :value])
	      bidders (-> players (bidding-team current-bid) (keyword))
	      bidders-score (get-in state [:info bidders :value])
	      bidders-score (if (made-bid? players current-bid (new-trick-state :info))
			      (+ bidders-score score-value)
			      (- bidders-score score-value))]
	  (set new-trick-state {:info {opponents {:value opponents-score} bidders {:value bidders-score}}
				:meta {}
				:stacks {}
				:phase "deal"}))

      # Continue the current hand.
      (let [player-to-prompt (find |(= ($0 :id) highest-player) players)
	    hand-to-prompt (player-to-prompt :hand)]
	(put new-trick-state :phase "play")
	(array/push events (prompt-play highest-player hand-to-prompt))))

    [new-trick-state events]))


(defn play-phase
  ```
  Players play to tricks.


@@ 41,42 141,10 @@
  - `bid`: The current contract.
  - `suit`: The led suit of the current trick.
  ```
  [old-state players {:player player :value card}]
  # We need to explicitly set the current suit to null. 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.
  (var new-state @{:info (old-state :info) :meta @{} :stacks @{}})
  (var events @[(events/add-decoration player "play_action" (string "played " (cards/to-text card)))])
  (let [current-trick (get-in old-state [:stacks :trick])
	current-bid (get-in old-state [:meta :bid])
	just-played (with-player card player)]
  [state players {:player player :value card-played}]
  (let [current-trick (get-in state [:stacks :trick])
	current-bid (get-in state [:meta :bid])
	just-played (with-player card-played player)]
    (case (length current-trick)
      3 (let [apply-ordering (cards/apply-ordering current-bid)
	      full-trick (array ;current-trick just-played)
	      with-compare (map apply-ordering full-trick) 
	      current-suit (get-in old-state [:meta :suit])
	      highest (cards/high-card current-suit (current-bid :suit) ;with-compare)
	      highest-player (highest :player)]
	  (update-in new-state [:info (keyword highest-player "_tricks") :value] inc)
	  (case (length ((players 0) :hand)) 
	    # It's the last trick of the hand.
	    # TODO: reckon scores and reset
	    1 :ok
	     (let [player-to-prompt (find |(= ($0 :id) highest-player) players)
		   hand-to-prompt (player-to-prompt :hand)]
	       (put new-state :phase "play")
		   (put-in new-state [:stacks :trick] [])
		   (array/push events (prompt-play highest-player hand-to-prompt)))))
      (let [old-meta (old-state :meta)
	    current-suit (old-meta :suit)
	    new-suit (new-suit current-suit current-bid card)
	    id-to-prompt (players/next-player player players)
	    player-to-prompt (find |(= ($0 :id) id-to-prompt) players)]
	(put new-state :phase "play")
	(put-in new-state [:meta :suit] new-suit)
	(put-in new-state [:stacks :trick] (add-to-stack current-trick just-played))
	(array/push
	 events
	 (prompt-play id-to-prompt (cards/of-suit-or-off new-suit current-bid (player-to-prompt :hand))))))
    [new-state events]))
      3 (end-trick players state current-trick current-bid just-played)
      (continue-trick players state current-trick current-bid just-played))))

M init.janet => init.janet +1 -5
@@ 7,11 7,7 @@
	     :max-size 4
	     :alignment :stagger}]
   :info [{:name "north_south" :label "North/South" :value 0}
	  {:name "east_west" :label "East/West" :value 0}
	  {:name "tricks_north" :value 0}
	  {:name "tricks_east" :value 0}
	  {:name "tricks_south" :value 0}
	  {:name "tricks_west" :value 0}]})
	  {:name "east_west" :label "East/West" :value 0}]})

(defn-
  make-player

M test/last-card.janet => test/last-card.janet +57 -22
@@ 8,48 8,83 @@
(cards/intern-cards!)

(def- two-cards-left
  [{:hand [C2 CA] :score 0 :team 1 :id "North"}
   {:hand [D2 DA] :score 0 :team 2 :id "East"}
   {:hand [H2 HA] :score 0 :team 1 :id "South"}
   {:hand [S2 SA] :score 0 :team 2 :id "West"}])
  [{:hand [C2 CA] :team "north_south" :id "North"}
   {:hand [D2 DA] :team "east_west" :id "East"}
   {:hand [H2 HA] :team "north_south" :id "South"}
   {:hand [S2 SA] :team "east_west" :id "West"}])

(deftest north-takes-the-trick
  (def player-lead @{:players two-cards-left
		     :state @{:phase "play" :meta @{:suit "clubs"
						    :bid @{:count 3 :suit "notrumps" :direction "up"}}
			      :info @{:North_tricks @{:value 0}}
		     :state @{:phase "play"
			      :meta @{:suit "clubs"
				      :bid @{:count 3 :suit "notrumps" :direction "up" :player "North"}}
			      :info @{:north_south @{:value 0}
				      :North_tricks @{:value 0}}
			      :stacks @{:trick [(merge-into @{:player "East"} CK)
						(merge-into @{:player "South"} D2)
						(merge-into @{:player "West"} S3)]}}
		     :action @{:player "North" :name "play" :value CA}})
  (def [state events] (whist/next player-lead))
  (def [north-decoration  north-prompt] events)
  (def [deco1 deco2 deco3 deco4 north-prompt] events)
  (let [played-card (merge-into @{:player "North"} CA)]
    (is (deep= @{} (state :meta)))
    (is (deep= @{:bid @{:count 3 :suit "notrumps" :direction "up" :player "North"}} (state :meta)))
    (is (deep= @{:trick []} (state :stacks)))
    (is (deep= @{:North_tricks @{:value 1}} (state :info))))
  (is (= {:value "played \xE2\x99\xA3Ace" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
    (is (deep= @{:North_tricks @{:value 1} :north_south @{:value 0}} (state :info))))
  (is (= {:event "clear_decoration" :player "North" :name "play_action"} deco1))
  (is (= {:event "clear_decoration" :player "East" :name "play_action"} deco2))
  (is (= {:event "clear_decoration" :player "South" :name "play_action"} deco3))
  (is (= {:event "clear_decoration" :player "West" :name "play_action"} deco4))
  (is (deep= {:player "North" :event "prompt_play" :count 1 :to "trick" :from [C2 CA]}
	     north-prompt)))

(def- last-cards
  [{:hand [CA] :score 0 :team 1 :id "North"}
   {:hand [DA] :score 0 :team 2 :id "East"}
   {:hand [HA] :score 0 :team 1 :id "South"}
   {:hand [SA] :score 0 :team 2 :id "West"}])
  [{:hand [] :team "north_south" :id "North"}
   {:hand [] :team "east_west" :id "East"}
   {:hand [] :team "north_south" :id "South"}
   {:hand [] :team "east_west" :id "West"}])

(deftest north-takes-the-last-trick
(deftest north-makes-the-bid
  (def player-lead @{:players last-cards
		     :state @{:phase "play" :meta @{:suit "clubs"
						    :bid @{:count 3 :suit "notrumps" :direction "up"}}
			      :info @{:North_tricks @{:value 0}}
		     :state @{:phase "play"
			      :meta @{:suit "clubs"
				      :bid @{:count 3 :suit "notrumps" :direction "up" :player "North"}}
			      :info @{:north_south @{:value 0}
				      :east_west @{:value 1}
				      :North_tricks @{:value 8} :South_tricks @{:value 0}}
			      :stacks @{:trick [(merge-into @{:player "East"} CK)
						(merge-into @{:player "South"} D2)
						(merge-into @{:player "West"} S3)]}}
		     :action @{:player "North" :name "play" :value CA}})
  (def [state events] (whist/next player-lead))
  # TODO: Test end of hand.
  (def [] events))
  (def [deco1 deco2 deco3 deco4] events)
  (is (= {:north_south {:value 6} :east_west {:value 1}} (state :info)))
  (is (= {} (state :meta)))
  (is (= {} (state :stacks)))
  (is (= {:player "North" :name "play_action" :event "clear_decoration"} deco1))
  (is (= {:player "East" :name "play_action" :event "clear_decoration"} deco2))
  (is (= {:player "South" :name "play_action" :event "clear_decoration"} deco3))
  (is (= {:player "West" :name "play_action" :event "clear_decoration"} deco4)))

(deftest north-fails-the-bid
  (def player-lead @{:players last-cards
		     :state @{:phase "play"
			      :meta @{:suit "clubs"
				      :bid @{:count 3 :suit "notrumps" :direction "up" :player "North"}}
			      :info @{:north_south @{:value 0}
				      :east_west @{:value 1}
				      :North_tricks @{:value 0} :South_tricks @{:value 0}}
			      :stacks @{:trick [(merge-into @{:player "East"} CK)
						(merge-into @{:player "South"} D2)
						(merge-into @{:player "West"} S3)]}}
		     :action @{:player "North" :name "play" :value CA}})
  (def [state events] (whist/next player-lead))
  (def [deco1 deco2 deco3 deco4] events)
  (is (= {:north_south {:value -6} :east_west {:value 1}} (state :info)))
  (is (= {} (state :meta)))
  (is (= {} (state :stacks)))
  (is (= {:player "North" :name "play_action" :event "clear_decoration"} deco1))
  (is (= {:player "East" :name "play_action" :event "clear_decoration"} deco2))
  (is (= {:player "South" :name "play_action" :event "clear_decoration"} deco3))
  (is (= {:player "West" :name "play_action" :event "clear_decoration"} deco4)))

(run-tests!)

M test/lead.janet => test/lead.janet +12 -12
@@ 23,8 23,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} CJ)]
    (is (deep= @{:suit "clubs"} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit "clubs" :bid {:count 3 :suit "notrumps" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played \xE2\x99\xA3J" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick"


@@ 40,8 40,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} J2)]
    (is (deep= @{:suit "clubs"} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit "clubs" :bid {:count 3 :suit "clubs" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played Big Joker" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick"


@@ 57,8 57,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} J1)]
    (is (deep= @{:suit :null} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit :null :bid {:count 3 :suit "notrumps" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played Little Joker" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick"


@@ 80,8 80,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} CK)]
    (is (deep= @{:suit "clubs"} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit "clubs" :bid {:count 3 :suit "clubs" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played \xE2\x99\xA3K" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick" :from @[CA J1]}


@@ 96,8 96,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} CK)]
    (is (deep= @{:suit "clubs"} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit "clubs" :bid {:count 3 :suit "diamonds" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played \xE2\x99\xA3K" :event "add_decoration" :player "North" :name "play_action"} north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick" :from @[CA]}
	     east-prompt)))


@@ 111,8 111,8 @@
  (def [state events] (whist/next player-lead))
  (def [north-decoration east-prompt] events)
  (let [played-card (merge-into @{:player "North"} CK)]
    (is (deep= @{:suit "clubs"} (state :meta)))
    (is (deep= @{:trick [played-card]} (state :stacks))))
    (is (deep= {:suit "clubs" :bid {:count 3 :suit "notrumps" :direction "up"}} (state :meta)))
    (is (deep= {:trick [played-card]} (state :stacks))))
  (is (= {:value "played \xE2\x99\xA3K" :event "add_decoration" :player "North" :name "play_action"} north-decoration))
  (is (deep= {:player "East" :event "prompt_play" :count 1 :to "trick" :from @[CA]}
	     east-prompt)))

M test/whist.janet => test/whist.janet +1 -1
@@ 101,7 101,7 @@
  (is (= {:value "3 Uptown: Clubs" :event "add_decoration" :player "high_bid" :name "North"} north-decoration))
  (is (= {:event "draw" :count 6 :player "North"} north-draw))
  (is (= {:event "prompt_discard" :count 6 :player "North"} north-prompt))
  (is (deep= {:phase "begin_play" :meta {:bid @{:count 3 :direction "up" :suit "clubs"}}} state)))
  (is (deep= {:phase "begin_play" :meta {:bid @{:count 3 :direction "up" :suit "clubs" :player "North"}}} state)))

(deftest begin-play
  (let [two-cards [CA C2]