~subsetpark/whist

b677ce25024b86d1b5ab62f4a77a8b359a07e8fc — Zach Smith 1 year, 1 month ago 3158373
Handle last card to trick
4 files changed, 85 insertions(+), 26 deletions(-)

M cards.janet
M game/play.janet
A test/last-card.janet
R test/{play.janet => lead.janet}
M cards.janet => cards.janet +6 -6
@@ 97,12 97,12 @@
		 @[_ _] (downtown (self :rank) (other :rank))))})

(defn apply-ordering [current-bid]
  (fn [card]
    (let [proto (match [(current-bid :suit) (current-bid :direction)]
		  @["notrumps" "up"] notrumps-card
		  @["notrumps" "down"] notrumps-downtown-card
		  @[trumps "up"] (uptown-card trumps)
		  @[trumps "down"] (downtown-card trumps))]
  (let [proto (match [(current-bid :suit) (current-bid :direction)]
		@["notrumps" "up"] notrumps-card
		@["notrumps" "down"] notrumps-downtown-card
		@[trumps "up"] (uptown-card trumps)
		@[trumps "down"] (downtown-card trumps))]
    (fn [card]
      (table/setproto card proto))))

(defn of-suit-or-off

M game/play.janet => game/play.janet +18 -12
@@ 22,6 22,9 @@
      [trumps "joker"] trumps
      [_ led-suit] led-suit)))

(defn- prompt-play [player from]
  {:event "prompt_play" :player player :to "trick" :count 1 :from from})

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


@@ 46,18 49,25 @@
  (var new-state @{: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])]
	current-bid (get-in old-state [:meta :bid])
	just-played (with-player card player)]
    (case (length current-trick)
      3 (let [ordering-f (cards/apply-ordering current-bid)
	      with-compare (map ordering-f 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 ;with-compare)
	      highest (cards/high-card current-suit (current-bid :suit) ;with-compare)
	      highest-player (highest :player)]
	  (array/push events {:event "add_score" :player highest-player :value 1})
	  (case (-> (players 0) (:hand) (length))
	  (case (length ((players 0) :hand)) 
	    # It's the last trick of the hand.
	    # TODO: reckon scores and reset
	    1 :ok
	    (put new-state :phase "play")))
	     (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)


@@ 65,12 75,8 @@
	    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 (with-player card player)))
	(put-in new-state [:stacks :trick] (add-to-stack current-trick just-played))
	(array/push
	 events
	 {:event "prompt_play"
	  :player id-to-prompt
	  :to "trick"
	  :count 1
	  :from (cards/of-suit-or-off new-suit current-bid (player-to-prompt :hand))})))
	 (prompt-play id-to-prompt (cards/of-suit-or-off new-suit current-bid (player-to-prompt :hand))))))
    [new-state events]))

A test/last-card.janet => test/last-card.janet +53 -0
@@ 0,0 1,53 @@
(import testament :prefix "")

(import whist)
(import bids)
(import init)
(import cards)

(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"}])

(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"}}
			    :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-add-score north-prompt] events)
  (let [played-card (merge-into @{:player "North"} CA)]
    (is (deep= @{} (state :meta)))
    (is (deep= @{:trick []} (state :stacks))))
  (is (= {:value "played \xE2\x99\xA3Ace" :event "add_decoration" :player "North" :name "play_action"}
	 north-decoration))
  (is (= {:event "add_score" :value 1 :player "North"} north-add-score))
  (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"}])

(deftest north-takes-the-last-trick
  (def player-lead {:players last-cards
		    :state {:phase "play" :meta {:suit "clubs"
						 :bid {:count 3 :suit "notrumps" :direction "up"}}
			    :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))

(run-tests!)

R test/play.janet => test/lead.janet +8 -8
@@ 9,10 9,10 @@
 
(def- players-with-full-hands
  # Discarded: Deuces + Jokers
  [{:hand [CA C3 C4 C5 C6 C7 C8 C9 CT CJ CQ CK] :score 0 :team 1 :meta {} :id "North"}
   {:hand [DA D3 D4 D5 D6 D7 D8 D9 DT DJ DQ DK] :score 0 :team 2 :meta {} :id "East"}
   {:hand [HA H3 H4 H5 H6 H7 H8 H9 HT HJ HQ HK] :score 0 :team 1 :meta {} :id "South"}
   {:hand [SA S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK] :score 0 :team 2 :meta {} :id "West"}])
  [{:hand [CA C3 C4 C5 C6 C7 C8 C9 CT CJ CQ CK] :score 0 :team 1 :id "North"}
   {:hand [DA D3 D4 D5 D6 D7 D8 D9 DT DJ DQ DK] :score 0 :team 2 :id "East"}
   {:hand [HA H3 H4 H5 H6 H7 H8 H9 HT HJ HQ HK] :score 0 :team 1 :id "South"}
   {:hand [SA S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK] :score 0 :team 2 :id "West"}])

(deftest lead-with-off-suit-follow
  (def player-lead {:players players-with-full-hands


@@ 66,10 66,10 @@
	     east-prompt)))

(def- east-with-clubs
  [{:hand [CA C3 C4 C5 C6 C7 C8 C9 CT CJ CQ] :score 0 :team 1 :meta {} :id "North"}
   {:hand [DA D3 D4 D5 D6 D7 D8 D9 DT DJ CA J1] :score 0 :team 2 :meta {} :id "East"}
   {:hand [HA H3 H4 H5 H6 H7 H8 H9 HT HJ HQ HK] :score 0 :team 1 :meta {} :id "South"}
   {:hand [SA S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK] :score 0 :team 2 :meta {} :id "West"}])
  [{:hand [CA C3 C4 C5 C6 C7 C8 C9 CT CJ CQ] :score 0 :team 1 :id "North"}
   {:hand [DA D3 D4 D5 D6 D7 D8 D9 DT DJ CA J1] :score 0 :team 2 :id "East"}
   {:hand [HA H3 H4 H5 H6 H7 H8 H9 HT HJ HQ HK] :score 0 :team 1 :id "South"}
   {:hand [SA S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK] :score 0 :team 2 :id "West"}])

(deftest trump-lead
  (def player-lead {:players east-with-clubs