~subsetpark/whist

9fa71c1362e590e1d72b46e4de95c005bc2ad8ff — Zach Smith 6 months ago dee5eaf
Refactor play phase in advance of wrapping into lit
M cards.janet => cards.janet +14 -6
@@ 96,7 96,7 @@
		 @[_ "joker"] 1
		 @[_ _] (downtown (self :rank) (other :rank))))})

(defn apply-ordering [current-bid]
(defn- make-compare-enable-fn [current-bid]
  (let [proto (match [(current-bid :suit) (current-bid :direction)]
		@["notrumps" "up"] notrumps-card
		@["notrumps" "down"] notrumps-downtown-card


@@ 112,12 112,20 @@
		  # If the led suit is trumps, then look for all cards
		  # of that suit or jokers.
		  (of-suit-or-jokers led-suit stack)
		  # Otherwise, look jus tfor cards of that suit.
		  # Otherwise, look just for cards of that suit.
		  (of-suit led-suit stack))]
    (if (> (length on-suit) 0) on-suit stack)))

(defn high-card [led-suit trumps & stack]
(defn high-card
  "Trick resolution for all Bid Whist games."
  (->> stack
       (of-suit-or-trumps led-suit trumps)
       (extreme compare>)))
  [stack led-suit bid]
  (let [f (make-compare-enable-fn bid)]
    (->> stack
	 # Get a version of the current-trick where
	 # each card has a `:compare` method that's
	 # aware of the current bid.
	 (map f)
	 (of-suit-or-trumps led-suit (bid :suit))
	 # Get the highest card according to each
	 # one's `:compare`.
	 (extreme compare>))))

M events.janet => events.janet +16 -13
@@ 1,36 1,39 @@
# events.janet
## events.janet
(import players)
# Hand side effects
# Events: Draw
## Events: Draw
(defn draw [player count] {:event "draw" :player player :count count})

# Decorations
# Events: Add Decoration
(defn add-decoration [player name value] {:event "add_decoration" :name name :player player :value value})

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

# Game Side Effects
## Events: End Game
(defn end-game
  [players team1 score1 team2 score2]
  (let [players1 (players/of-team players (string team1))
	players2 (players/of-team players (string team2))]
    {:event "end_game" :scores (zipcoll (array/concat players1 players2)
					[score1 score1 score2 score2])}))

# Decorations
## Events: Add Decoration
(defn add-decoration [player name value] {:event "add_decoration" :name name :player player :value value})

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

# Prompts
# Events: Pick 1
## Events: Pick 1
(defn pick1 [name player choices] {:event "prompt_select" :name name :player player :count 1 :from choices})

# Events: Prompt Play
## Events: Prompt Play
(defn prompt-play
  [player &opt from]
  {:event "prompt_play" :player player :to "trick" :count 1 :from from})

# Events: Prompt Discard
## Events: Prompt Discard
(defn prompt-discard [player count] {:event "prompt_discard" :player player :count count})

# State labels
# Events: Add Info
## Events: Add Info
(defn add-info [id label] {:event "add_info" :id id :label label})



M game/beginplay.janet => game/beginplay.janet +4 -4
@@ 1,15 1,15 @@
# game/beginplay.janet
## game/beginplay.janet
(import events)

# Initial Stacks
## Initial Stacks
(defn- init-stacks [] {:trick []})

# Initial Counters
## Initial Counters
(defn- tricks-counter [player-name] (keyword player-name "_tricks"))

(defn- init-counters [bidder other-players]
  (var counters (zipcoll (map |(tricks-counter ($0 :id)) other-players)
			 (map (fn [_] 0) other-players)))
                         (map (fn [_] 0) other-players)))
  # It's the first trick; bidder gets one trick for the discard.
  (put counters (tricks-counter bidder) 1))


M game/bid.janet => game/bid.janet +12 -12
@@ 1,9 1,9 @@
# game/bid.janet
## game/bid.janet
(import players)
(import bids)
(import events)

# New Meta
## New Meta
(defn- new-meta
  [{:meta meta} {:value last-bid :player last-bidder}]
  (let [{:bid previous-high-bid :player previous-high-bidder} (meta :high_bid)


@@ 13,7 13,7 @@
                                 [last-bid last-bidder])]
    @{:high_bid @{:player high-bidder :bid high-bid}}))

# Initial Bidding Events
## Initial Bidding Events
(defn- initial-events
  [{:meta {:high_bid {:bid previous-high-bid :player previous-high-bidder}}}
   {:value last-bid :player last-bidder}


@@ 27,7 27,7 @@
     (events/add-decoration last-bidder "bid_action" "declarer")
     (events/add-decoration last-bidder "bid" (bids/to-text current-high-bid)))))

# Update Not Passed
## Update Not Passed
(defn- update-not-passed
  [{:meta {:not_passed not-passed}} {:value last-bid :player last-bidder}]
  (case last-bid


@@ 35,7 35,7 @@
    "pass" (put not-passed (keyword last-bidder) nil))
    not-passed)

# Main Bid Function
## Main Bid Function
(defn bid-phase
  ```
  The players bid in an auction to name trump. 


@@ 49,16 49,16 @@
  ```
  [state players action]
  (if (= action :null) (error {:error "action required"}))
  # Handle the Bid Action
  (let  [new-meta (new-meta state action)
         {:high_bid {:player high-bidder :bid high-bid}} new-meta
         events (initial-events state action high-bid)
         not-passed (update-not-passed state action)]
  ## Handle the Bid Action
  (let [new-meta (new-meta state action)
        {:high_bid {:player high-bidder :bid high-bid}} new-meta
        events (initial-events state action high-bid)
        not-passed (update-not-passed state action)]
    # The set of players still in the auction is now up to date. We'll
    # use it to determine whether the action is over.
    (if (and (not (nil? high-bidder)) (= 1 (length not-passed)))
      # If someone has bid and all but one have passed, the auction is over.
      # End the Auction
      ## End the Auction
      [(merge state {:meta new-meta
                     # State: Bid -> Discard
                     :phase "discard"})


@@ 66,7 66,7 @@
       (array/push events (events/pick1 "bid" high-bidder (bids/second-bid high-bid)))]

      # Otherwise, continue the bidding.
      # Continue the Auction
      ## Continue the Auction
      (let [{:player last-bidder} action
            next-bidder (players/next-player last-bidder players not-passed)]
        (array/push events (events/add-decoration next-bidder "bid_action" "bidding"))

M game/deal.janet => game/deal.janet +8 -8
@@ 1,15 1,15 @@
# game/deal.janet
## game/deal.janet
(import events)
(import bids)

# Each Player Draws
## Each Player Draws
(defn- all-draw [players] (map |(events/draw ($0 :id) 12) players))

# Initialize Metadata
## Initialize Metadata
(defn- new-meta [players] {:high_bid {}
                           :not_passed (zipcoll (map |($0 :id) players) [true true true true])})

# Main Deal Function
## Main Deal Function
(defn deal-phase
  ```
  Each player starts with 12 cards. 


@@ 17,17 17,17 @@
  The first player is prompted to begin bidding.
  ```
  [state players]
  # Get The First Player
  ## Get The First Player
  (let [bidder ((in players 0) :id)]

  # Return Value
  ## Return Value
  [
   # New State
   ## New State
   # State: Deal -> Bid 
   (merge state {:phase "bid"
                 :meta (new-meta players)})

   # Deal Events
   ## Deal Events
   (array/concat
    (all-draw players)
    (events/add-decoration bidder "bid_action" "bidding")

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


M game/play.janet => game/play.janet +80 -73
@@ 4,8 4,6 @@

(def score-threshold 7)
 
(defn- add-to-stack [stack card] (tuple ;stack card))
(defn- with-player [card player] (merge-into @{:player player} card))
(defn- new-suit
  ```
  Determine the led suit in a given trick.


@@ 28,15 26,51 @@
      [trumps "joker"] trumps
      [_ led-suit] led-suit)))

(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- with-player [card player] (merge-into @{:player player} card))

(defn- add-to-stack [stack card] (tuple ;stack 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]]))

(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))))

(defn- total-tricks [players bid info]
  (let [bidding-team (bidding-team players bid) 
	total-tricks (->> (players/of-team players bidding-team)
			  (map |(keyword $0 "_tricks"))
			  (map |(info $0))
			  (sum))]))
(defn- made-bid?
  ```
  A team has made a bid if their combined tricks is greater than or equal to their bid + 6.


@@ 44,10 78,6 @@
  [total-tricks bid]
  (>= total-tricks (+ 6 (bid :count)))) 

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

(defn- adjustment-for-bid
  ```
  A contract's value is its numerical value, or double its value if it's notrumps.


@@ 57,66 87,44 @@
    "notrumps" |(* $0 2)
    |$0))
 
(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 card-played player]
  (let [just-played (with-player card-played player)
	old-meta (state :meta)
        current-bid (get-in state [:meta :bid])
        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)))
      (events/prompt-play id-to-prompt prompt-choices)]]))
(defn- tricks-value
  [total-tricks]
  (- total-tricks 6))

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

(defn- continue-hand [players events info current-bid highest-player]
  (let [player-to-prompt (find |(= ($0 :id) highest-player) players)
        hand-to-prompt (player-to-prompt :hand)]
    (array/push events (events/prompt-play highest-player hand-to-prompt))
    # State: Play->Play
    [@{:phase "play"
       :info info
       :meta @{:bid current-bid :suit "undefined"}
       :stacks @{:trick []}}
     events]))
(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])

(defn- next-hand [players events info current-bid]
  (let [total-tricks (total-tricks players current-bid info)
	score-multiplier (adjustment-for-bid current-bid)
        score-multiplier (adjustment-for-bid current-bid)
        opponent-team-keyword (-> players (non-bidding-team current-bid) (keyword))
        opponents-score (in info opponent-team-keyword)
        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) )))
        end-of-hand-info {opponent-team-keyword opponents-score
			  bidding-team-keyword bidders-score}
        game-end-event (events/end-game players
					bidding-team-keyword
					bidders-score
					opponent-team-keyword
					opponents-score)]
            
                        (- bidders-score (-> current-bid (in :count) (score-multiplier) )))]
    
    (if (or (won? bidders-score) (lost? bidders-score))
      (array/push events game-end-event))
      (array/push events (events/end-game players
                                          bidding-team-keyword
                                          bidders-score
                                          opponent-team-keyword
                                          opponents-score)))
    # State: Play->Deal
    [@{:phase "deal" :info end-of-hand-info} events]))
    [@{:phase "deal"
       :info {opponent-team-keyword opponents-score
              bidding-team-keyword bidders-score}}
     events]))

(defn- end-trick
  ```


@@ 125,24 133,20 @@
  Determine which card takes the trick and update: the number of
  tricks taken; if applicable, the team scores.
  ```
  [players state current-trick card-played player]
  (let [just-played (with-player card-played player)
	current-bid (get-in state [:meta :bid])
        apply-ordering-fun (cards/apply-ordering current-bid)
        full-trick (array ;current-trick just-played)
        trick-with-compare (map apply-ordering-fun full-trick) 
        current-suit (get-in state [:meta :suit])
        highest-card (cards/high-card current-suit (current-bid :suit) ;trick-with-compare)
        highest-player (highest-card :player)
  [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 highest-player "_tricks") inc)]
        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 players events updated-info current-bid highest-player))))
      (continue-hand events updated-info current-bid winning-player))))


(defn play-phase


@@ 162,7 166,10 @@
  - `suit`: The led suit of the current trick.
  ```
  [state players {:player player :value @[card-played]}]
  (let [current-trick (get-in state [:stacks :trick])]
  (let [just-played (with-player card-played player)
        current-trick (-> state
                          (get-in [:stacks :trick])
                          (add-to-stack just-played))]
    (case (length current-trick)
      3 (end-trick players state current-trick card-played player)
      (continue-trick players state current-trick card-played player))))
      4 (end-trick players state current-trick)
      (continue-trick players state current-trick just-played))))

M lit/events.lit => lit/events.lit +2 -6
@@ 4,15 4,11 @@
(import players)
# Hand side effects
@{Events: Draw}
# Game Side Effects
@{Events: End Game}
# Decorations
@{Events: Add Decoration}
@{Events: Clear Decoration}
(defn end-game
  [players team1 score1 team2 score2]
  (let [players1 (players/of-team players (string team1))
	players2 (players/of-team players (string team2))]
    {:event "end_game" :scores (zipcoll (array/concat players1 players2)
					[score1 score1 score2 score2])}))
# Prompts
@{Events: Pick 1}
@{Events: Prompt Play}

M test/cards.janet => test/cards.janet +24 -34
@@ 9,18 9,8 @@
       (in {(chr "D") true (chr "S") true (chr "C") true (chr "H") true (chr "J") true} (0 sym))))

(defmacro test-with-bid [bid & tests]
  (let [trumps (bid :suit)
	tests
	(postwalk
	 (fn [form]
	   (cond
	     (is-card-sym? form) ~((cards/apply-ordering ,bid) ,form)
	     (and
	       (tuple? form)
	       (= 'cards/high-card (form 0))) (-> (array ;form) (array/insert 2 trumps) (freeze)) 
	     form))
	 tests)]
    ~(deftest ,(symbol (string/format "%j" bid)) ,;tests)))
  ~(let [hc (fn [s] (cards/high-card s "diamonds" ,bid))]
       (deftest ,(symbol (string/format "%j" bid)) ,;tests)))

(defmacro card= [c1 c2 note]
  (with-syms [$c1 $c2]


@@ 29,33 19,33 @@
	(is (= (,$c1 :rank) (,$c2 :rank)) (string ,note " (by rank)"))])))

(test-with-bid {:suit "clubs" :direction "up"}
	       (card= J1 (cards/high-card "diamonds" J1 C2) "jokers beat anything")
	       (card= J2 (cards/high-card "diamonds" J1 J2) "big joker beats little joker")
	       (card= D3 (cards/high-card "diamonds" D2 D3) "led suits rank normally")
	       (card= D2 (cards/high-card "diamonds" D2 S3) "led suits beat higher-off-suit")
	       (card= C2 (cards/high-card "diamonds" D3 C2) "trump beats higher off-suit"))
	       (card= J1 (hc [J1 C2]) "jokers beat anything")
	       (card= J2 (hc [J1 J2]) "big joker beats little joker")
	       (card= D3 (hc [D2 D3]) "led suits rank normally")
	       (card= D2 (hc [D2 S3]) "led suits beat higher-off-suit")
	       (card= C2 (hc [D3 C2]) "trump beats higher off-suit"))

(test-with-bid {:suit "clubs" :direction "down"}
	       (card= J1 (cards/high-card "diamonds" J1 C2) "jokers beat anything")
	       (card= J2 (cards/high-card "diamonds" J2 J1) "big joker beats little joker")
	       (card= D2 (cards/high-card "diamonds" D2 D3) "led suits rank reversed")
	       (card= D3 (cards/high-card "diamonds" D3 S2) "led suits beat higher-off-suit")
	       (card= C3 (cards/high-card "diamonds" D2 C3) "trump beats higher off-suit"))
	       (card= J1 (hc [J1 C2]) "jokers beat anything")
	       (card= J2 (hc [J2 J1]) "big joker beats little joker")
	       (card= D2 (hc [D2 D3]) "led suits rank reversed")
	       (card= D3 (hc [D3 S2]) "led suits beat higher-off-suit")
	       (card= C3 (hc [D2 C3]) "trump beats higher off-suit"))

(test-with-bid {:suit "notrumps" :direction "up"}
	       (card= D2 (cards/high-card "diamonds" J2 D2) "jokers never win (1)")
	       (card= D2 (cards/high-card "diamonds" J1 D2) "jokers never win (2)")
	       (card= J2 (cards/high-card "diamonds" J1 J2) "big joker beats little joker")
	       (card= D3 (cards/high-card "diamonds" D2 D3) "led suits rank normally")
	       (card= D3 (cards/high-card "diamonds" D3 S2) "led suits beat higher-off-suit")
	       (card= D2 (cards/high-card "diamonds" D2 C3) "trump doesn't beat higher off-suit"))
	       (card= D2 (hc [J2 D2]) "jokers never win (1)")
	       (card= D2 (hc [J1 D2]) "jokers never win (2)")
	       (card= J2 (hc [J1 J2]) "big joker beats little joker")
	       (card= D3 (hc [D2 D3]) "led suits rank normally")
	       (card= D3 (hc [D3 S2]) "led suits beat higher-off-suit")
	       (card= D2 (hc [D2 C3]) "trump doesn't beat higher off-suit"))

(test-with-bid {:suit "notrumps" :direction "down"}
	       (card= D2 (cards/high-card "diamonds" J2 D2) "jokers never win (1)")
	       (card= D2 (cards/high-card "diamonds" J1 D2) "jokers never win (2)")
	       (card= J2 (cards/high-card "diamonds" J1 J2) "big joker beats little joker")
	       (card= D2 (cards/high-card "diamonds" D2 D3) "led suits rank reversed")
	       (card= D3 (cards/high-card "diamonds" D3 S2) "led suits beat higher-off-suit")
	       (card= D2 (cards/high-card "diamonds" D2 C3) "trump doesn't beat higher off-suit"))
	       (card= D2 (hc [J2 D2]) "jokers never win (1)")
	       (card= D2 (hc [J1 D2]) "jokers never win (2)")
	       (card= J2 (hc [J1 J2]) "big joker beats little joker")
	       (card= D2 (hc [D2 D3]) "led suits rank reversed")
	       (card= D3 (hc [D3 S2]) "led suits beat higher-off-suit")
	       (card= D2 (hc [D2 C3]) "trump doesn't beat higher off-suit"))

(run-tests!)

M test/last-card.janet => test/last-card.janet +1 -1
@@ 35,7 35,7 @@
  (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]}
  (is (deep= {:player "North" :event "prompt_play" :count 1 :to "trick"}
	     north-prompt)))

(def- last-cards

M whist.css => whist.css +195 -0
@@ 1,4 1,199 @@
@import url('https://fonts.googleapis.com/css2?family=IBM+Plex+Serif:ital,wght@0,400;0,700;1,400;1,700&family=Old+Standard+TT:ital,wght@0,400;0,700;1,400&display=swap');

p:not(.notp) {
    margin-bottom: 1em;
    text-indent: 0;
}
body {
    font-family: 'IBM Plex Serif', serif;
    padding-top: 20px;
    padding-bottom: 60px;
    font-size: 16px;
    color: #222;
    background-color: #FFFFFD;
}

.hljs {
    background-color: #FFFFEA !important;
}

a {
    color: black;
    text-decoration: underline;
}

a:hover {
    color: #bffff;
}

pre {
    background-color: #FFFFEA;
    border: none;
}

h1 {
    font-family: 'Old Standard TT', serif;
}

h2 {
    font-family: 'Old Standard TT', serif;
    font-size: 26px;
}

h3 {
    font-family: 'Old Standard TT', serif;
}

h4 {
    font-family: 'Old Standard TT', serif;
}

code {
    font-family: "Iosevka", monospace;
    color: black;
    background-color: #FFFFEA;
}

blockquote {
    font-style: italic;
    font-size: 16px;
    color: #333;
    background-color: #FFFFEA;
    border: none;
}

figure {
    padding-top: 30px;
    padding-bottom: 30px;
}

figcaption {
    font-size: 12px;
}

.container .jumbotron {
}

.jumbotron {
    margin: 0 0 40px;
    padding: 20px 10px 30px;
    text-align: center;
    background-color: #FFFFFD;
}

.jumbotron h1 {
    font-size: 52px;
    line-height: 1;
}
.jumbotron .lead {
    font-size: 24px;
    line-height: 1.25;
}
.jumbotron .btn {
    font-size: 21px;
    padding: 14px 24px;
}
.jumbotron p {
    font-family: "Iosevka", monospace;
}
.marketing {
    margin: 60px 0;
}
.marketing p + h4 {
    margin-top: 28px;
}

.navbar .navbar-inner {
    padding: 0;
}
.navbar .nav {
    margin: 0;
    display: table;
    width: 1%;
}
.navbar .nav li {
    display: table-cell;
    width: 1%;
    float: none;
}
.navbar .nav li a {
    font-family: 'Old Standard TT', serif;
    font-weight: bold;
    text-align: center;
    border-left: 1px solid rgba(255,255,255,.75);
    border-right: 1px solid rgba(0,0,0,.1);
}

.navbar .nav li a:hover {
    background-color: #FFFFFD;
}

.navbar .nav li:first-child a {
    border-left: 0;
    border-radius: 0 0 0 0;
}
.navbar .nav li:last-child a {
    border-right: 0;
    border-radius: 0 0 0 0;
}

.body {
    padding: 0 10px;
}

.recent-posts tr {
    vertical-align: top;
}

.recent-posts td {
    padding-right: 10px;
    padding-bottom: 5px;
    border-style: hidden;
}

.post-info {
    font-style: italic;
}

table {
    margin: auto;
    margin-bottom: 15px;
    font-family: "Iosevka", monospace;
}

th {
    text-align: center;
    padding-right: 10px;
}

td {
    border-width: 1px;
    border-style: solid;
    padding: 5px;
    text-align: right;
    background-color: #FFFFEA;
}

.footnote {
  vertical-align: baseline;
  position: relative;
  top: -0.4em;
  font-size: 80%;
}

sup {
  vertical-align: super;
  font-size: smaller;
}

.oneline {
  overflow: hidden;
  text-overflow: ellipsis;
  white-space: nowrap;
}
.oneline br {
  display: none;
}
.oneline p {
  display: inline;
}

M whist.janet => whist.janet +3 -3
@@ 1,11 1,11 @@
# whist.janet
## whist.janet
(import game/deal)
(import game/bid)
(import game/discard)
(import game/beginplay)
(import game/play)

# `next` Function Signature
## `next` Function Signature
(defn next
  ```
  Rules engine for Bid Whist.


@@ 13,7 13,7 @@
  [{:state state
    :players players
    :action action}]
  # Return Next State
  ## Return Next State
  (match (state :phase)
    "deal" (deal/deal-phase state players)
    "bid" (bid/bid-phase state players action)

M whist.lit => whist.lit +361 -7
@@ 1,7 1,10 @@
@title Bid Whist: An Implementation for Tamerlane
@code_type janet .janet
@comment_type # %s
@compiler JANET_PATH=janet_modules jpm build
@comment_type ## %s

<link href="https://fonts.googleapis.com/css2?family=Old+Standard+TT:ital,wght@0,400;0,700;1,400&display=swap" rel="stylesheet">
<link href="https://fonts.googleapis.com/css2?family=IBM+Plex+Serif:ital,wght@0,400;0,700;1,400;1,700&display=swap" rel="stylesheet">


@add_css whist.css
@colorscheme atelier.css


@@ 311,10 314,10 @@ if we've reached that condition, and if so, end the auction. Otherwise
we'll continue.

--- Handle the Bid Action
(let  [new-meta (new-meta state action)
       {:high_bid {:player high-bidder :bid high-bid}} new-meta
       events (initial-events state action high-bid)
       not-passed (update-not-passed state action)]
(let [new-meta (new-meta state action)
      {:high_bid {:player high-bidder :bid high-bid}} new-meta
      events (initial-events state action high-bid)
      not-passed (update-not-passed state action)]
  # The set of players still in the auction is now up to date. We'll
  # use it to determine whether the action is over.
  (if (and (not (nil? high-bidder)) (= 1 (length not-passed)))


@@ 570,7 573,7 @@ will have a count of current tricks and each team will have a score.

(defn- init-counters [bidder other-players]
  (var counters (zipcoll (map |(tricks-counter ($0 :id)) other-players)
			 (map (fn [_] 0) other-players)))
                         (map (fn [_] 0) other-players)))
  # It's the first trick; bidder gets one trick for the discard.
  (put counters (tricks-counter bidder) 1))
---


@@ 653,4 656,355 @@ associates an info box ID with a more friendly label (in this case

[^player-names]: Update this with Player Names.

@s Play

In the play phase, players take turns playing a single card to a
trick. Whoever wins the trick leads to the next one.

This creates a situation similar to the bidding phase: whenever we
handle a call in this phase, there are two main cases:

- Each player has played a single card to the trick; resolve the
  trick.
- We're in the middle of the trick.

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

(defn play-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))))
---

We've structured our program so that the beginning of the play, before
someone has led the first card, is the previous phase. That allows us
to always assume that someone has played a card in order to enter this
function.

Notice that the value of the action is an array of cards, though we
assume that only one card was passed in; since the `prompt_play`
prompt is able to specify more than one card, an incoming `play`
action will always refer to a list of cards---whether the player was
prompted for one or more.

@s Proceeding with the Trick

Let's first handle the case where the current trick continues.

The main bit of state we need to maintain, in addition to adding the
just-played card to the `trick` stack, is the *led suit*, if any, of
the current trick.

@s Determining the Current Suit

There are a few different possibilities to handle when it comes to
determining the current suit.

The simplest is that the suit has already been determined when a
previous player played to the trick. If that's the case, it can't be
changed. On the other hand, if it's `"undefined"` (which is what we
initialized it to in the previous phase), we probably need to
set it for the rest of the trick. This value will determine both what
cards can be played by other players, as well as which played card
wins the trick.

--- 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)))
---

There's one subtle edge case we need to cover: if the bid was a
no-trumps bid, and if the led card is a joker, the suit remains
undefined. This means we can't assume that the first card is
the one that determines the suit; that's why we have to look for the
string `"undefined"` rather than assuming it's always set on the first
lead to the trick.

@s

Once we've determined the suit of the trick, we simply need to add the
played card to the trick and prompt the next player to play. 

--- 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]]))
---

@s Ending the Trick

Finishing the current trick is more complex, because there are two
options again:

- This is the last trick of the hand, in which case we need to adjust
  the team scores, and either end the game or go back to a new deal;
- We're in the middle of the hand and we should clear this trick.

Either case begins with determining who wins the trick and updating
the trick counters accordingly.

After that, we can decide between the two simply by looking at one of
the players' hands and seeing if there are any cards left to play.

--- 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))))
---

@s Proceeding with the Hand

The simpler case is that the players have more cards left, and thus we
should simply continue the current hand. To do so we just need to
clear out any state specific to this trick and prompt the winner to
play again.

--- 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])
---

@s Ending the Hand

More complex is if this is the end of the hand, ie, if the players
have played all their cards.

There's more bookkeeping in this case. We need to do a few things in
order:

- Determine the total number of tricks made by the declaring team;
- Determine if they've made their bid;
- Determine the adjustment to the declarers' score;
- Determine if the declarers have gone above the winning threshold or
  below the losing threshold, and end the game if so.

@s Getting the Total Number of Tricks

We don't actually keep track of the total number of tricks made by
each team (though we certainly could); that means that at the end of
the end, we need to figure out which player is on which team, get
those players' tricks taken, and add them together.

--- 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))))
---

@s Getting the Score Multiplier

One interesting wrinkle in Bid Whist is that if the bid was in
no-trumps, the value of the hand---positive or negative---is
doubled. We can handle that by either returning a multiplier function which
either doubles a value, or one that simply returns it.

If the declaring team fails their bid, the negative value of the hand
is whatever they bid. If they make their bid, the positive value of
the hand is the number of tricks that they make minus 6.

--- 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))
---

@s Checking For Win Conditions

It's quite straightforward to tell if the bidding team has won or
lost a hand: they simply need to have taken their bid + 6.

Similarly, a team has won the game if they go above 7 game points;
they have lost the game if they go below -7 game points.

--- 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)))) 
---

@s

Now that we know the win conditions for a hand and game, we can adjust
the scores accordingly.

In both cases, it's only the declarers' scores that need to be
adjusted. We only need to pull out the opponents' score from the game
info in order to populate the new state with it.

--- 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]))
---

@s Ending the Game

If the bidders have won or lost, the game is over. In the Tamerlane
system, we simply end a game by emitting an event; it's not part of
the game state.

@s End Game

Different card games have different concepts of ending a game; in some
games (such as this one), teams win and lose a game together; in some,
each player plays for themselves; in yet others, players might be on
fixed or shifting teams and still score differently.

To accomodate that degree of flexibility, we end a game in the
Tamerlane system by emitting an event that contains a total ranking of
all the players by score. In a game like Bid Whist, where players are
on fixed teams, both players on a team will end the game with the same
score. Thus, out of four players, two will be in first place and two
will be in second place.

The specific format of the `scores` value is a struct mapping each
player ID to their final score.

--- Events: End Game
(defn end-game
  [players team1 score1 team2 score2]
  (let [players1 (players/of-team players (string team1))
	players2 (players/of-team players (string team2))]
    {:event "end_game" :scores (zipcoll (array/concat players1 players2)
					[score1 score1 score2 score2])}))
---

@include lit/events.lit
\ No newline at end of file