~subsetpark/whist

18a5446a58efa8d6444719443d57c93ffa5bcaa9 — Zach Smith 6 months ago 6c4b421
Incorporate lit through discard
8 files changed, 365 insertions(+), 44 deletions(-)

A atelier.css
M events.janet
M game/bid.janet
M game/deal.janet
M game/discard.janet
M lit/events.lit
A whist.css
M whist.lit
A atelier.css => atelier.css +3 -0
@@ 0,0 1,3 @@
/*! Color themes for Google Code Prettify | MIT License | github.com/jmblog/color-themes-for-google-code-prettify */

.prettyprint{background:#fefbec;font-family:Menlo,Bitstream Vera Sans Mono,DejaVu Sans Mono,Monaco,Consolas,monospace;border:0!important}.pln{color:#20201d}ol.linenums{margin-top:0;margin-bottom:0;color:#999580}li.L0,li.L1,li.L2,li.L3,li.L4,li.L5,li.L6,li.L7,li.L8,li.L9{padding-left:1em;background-color:#fefbec;list-style-type:decimal}@media screen{.str{color:#60ac39}.kwd{color:#b854d4}.com{color:#999580}.typ{color:#6684e1}.lit{color:#b65611}.pun{color:#20201d}.opn{color:#20201d}.clo{color:#20201d}.tag{color:#d73737}.atn{color:#b65611}.atv{color:#1fad83}.dec{color:#b65611}.var{color:#d73737}.fun{color:#6684e1}}

M events.janet => events.janet +2 -2
@@ 10,7 10,7 @@
# 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})

(defn end-game


@@ 21,7 21,7 @@
					[score1 score1 score2 score2])}))

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

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

(defn add-info [id label] {:event "add_info" :id id :label label})

M game/bid.janet => game/bid.janet +36 -20
@@ 1,16 1,19 @@
# game/bid.janet
(import players)
(import bids)
(import events)

# 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)
	# Record the high bid (whether it's a new bid or the existing high bid).
	[high-bid high-bidder] (case last-bid
				 "pass" [previous-high-bid previous-high-bidder]
				 [last-bid last-bidder])]
        # Record the high bid (whether it's a new bid or the existing high bid).
        [high-bid high-bidder] (case last-bid
                                 "pass" [previous-high-bid previous-high-bidder]
                                 [last-bid last-bidder])]
    @{:high_bid @{:player high-bidder :bid high-bid}}))

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


@@ 24,6 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
(defn- update-not-passed
  [{:meta {:not_passed not-passed}} {:value last-bid :player last-bidder}]
  (case last-bid


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

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


@@ 44,29 49,40 @@
  ```
  [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)]
         {: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
      [(merge state {:meta new-meta
		     # State: Bid -> Discard
		     :phase "discard"})
                     # State: Bid -> Discard
                     :phase "discard"})
       # Bidder selects suit in a trumps bid or direction in a no-trumps bid.
       (array/push events (events/pick1 "bid" high-bidder (bids/second-bid high-bid)))]

      # Otherwise, continue the bidding.
      # 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"))
	# The auction isn't over; include the set of players still bidding in the metadata.
	[(merge state {:meta (put new-meta :not_passed not-passed)
		       # State: Bid -> Bid
		       :phase "bid"})
	 (if (= 1 (length not-passed))
	   # If no one has bid and all but one have passed, the dealer has to bid.
	   (array/push events (events/pick1 "bid" next-bidder (bids/force-bid)))
	   # Otherwise, move to the next bidder.
	   (array/push events (events/pick1 "bid" next-bidder (bids/available-bids high-bid))))]))))
            next-bidder (players/next-player last-bidder players not-passed)]
        (array/push events (events/add-decoration next-bidder "bid_action" "bidding"))
        # The auction isn't over; include the set of players still bidding in the metadata.
        [(merge state {:meta (put new-meta :not_passed not-passed)
                       # State: Bid -> Bid
                       :phase "bid"})
         (if (= 1 (length not-passed))
           # If no one has bid and all but one have passed, the dealer has to bid.
           (array/push events (events/pick1 "bid" next-bidder (bids/force-bid)))
           # Otherwise, move to the next bidder.
           (array/push events (events/pick1 "bid" next-bidder
                                             (bids/available-bids high-bid))))])

  ))

)



M game/deal.janet => game/deal.janet +1 -1
@@ 7,7 7,7 @@

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

# Main Deal Function
(defn deal-phase

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



@@ 17,12 18,15 @@
  ```
  [{:meta {:high_bid {:bid high-bid}}} players {:player bidder :value 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))] 
        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}}
	(array/concat
	 (map |(events/clear-decoration ($0 :id) "bid") players)
	 (map |(events/clear-decoration ($0 :id) "bid_action") players)
	 [(events/add-decoration bidder "high_bid" full-bid-text)
	  (events/draw bidder 6)
	  (events/prompt-discard bidder 6)])]))
        (array/concat
         (map |(events/clear-decoration ($0 :id) "bid") players)
         (map |(events/clear-decoration ($0 :id) "bid_action") players)
         (events/add-decoration bidder "high_bid" full-bid-text)
         (events/draw bidder 6)
         (events/prompt-discard bidder 6))]))


M lit/events.lit => lit/events.lit +2 -6
@@ 6,9 6,7 @@
@{Events: Pick 1}
@{Events: Draw}
@{Events: Add Decoration}

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

@{Events: Clear Decoration}
(defn end-game
  [players team1 score1 team2 score2]
  (let [players1 (players/of-team players (string team1))


@@ 17,8 15,6 @@
					[score1 score1 score2 score2])}))

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

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

@{Events: Prompt Discard}
(defn add-info [id label] {:event "add_info" :id id :label label})
---
\ No newline at end of file

A whist.css => whist.css +4 -0
@@ 0,0 1,4 @@
p:not(.notp) {
    margin-bottom: 1em;
    text-indent: 0;
}

M whist.lit => whist.lit +306 -8
@@ 3,6 3,9 @@
@comment_type # %s
@compiler JANET_PATH=janet_modules jpm build

@add_css whist.css
@colorscheme atelier.css

@s Introduction

This program implements a **rules engine** for Tamerlane, the Card


@@ 10,6 13,12 @@ Game Server. It provides a working version of the game Bid Whist, as
well as an example implementation of a realistically complex rules
engine.

The most important function that we need to implement when building a
rules engine is `next`. Ultimately, we'll expose an API endpoint that
accepts a POST request and passes the body to `next`. The input to our
function describes the state of the entire session, and the return
value of this function will be to describe *what happens next.*

--- whist.janet
(defn next
  ```


@@ 21,12 30,6 @@ engine.
  @{Return Next State})
---

The most important function that we need to implement when building a
rules engine is `next`. Ultimately, we'll expose an API endpoint that
accepts a POST request and passes the body to `next`. The input to our
function describes the state of the entire session, and the return
value of this function will be to describe *what happens next.*

The three components of the input are the `state`, the `players`, and
an `action`.



@@ 144,7 147,7 @@ all the players. We'll use them both in the bidding phase.

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

@s


@@ 220,7 223,7 @@ rules server, and the value of their selection will be the `action`.

In this case, the choices are a list of possible bids. Thus the bid phase begins.

@s
@s deal.janet

We've now performed everything we need to complete the deal: we've set
up our state, populated the players' hands, set a player decoration,


@@ 235,4 238,299 @@ and prompted for the first player action.
@{Main Deal Function}
---

@s The Auction

The "Bid" in "Bid Whist" is an auction for the right to *name
trumps*. The players, starting to the left of the dealer, take turns
bidding on which team will undertake a contract to win the highest
number of tricks. Whichever player wins the auction becomes the
*declarer* and announces what the trump suit will be.

Our bid function is structured quite similarly to the deal
function. One important difference, however, is that now we actually
handle `action`. Referring to @{whist.janet}, we always pattern match
on `action` in the incoming request body; however, it doesn't matter
in the deal. Intuitively, this makes sense; the deal is the first
thing that happens and there's no player input necessary to evaluate it.

The auction, and the rest of the game to boot, are different. In
@{Deal Events} we prompted the first player for their opening bid;
therefore, we expect that this incoming bid action is the next input
that the server will receive.[^stateless]

[^stateless]: Of course, in production, we should expect that we will
be receiving many requests from different ongoing games at
once. That doesn't pose any difficulty as our game rules server is
stateless. Every request will contain everything needed to evaluate
the next state of the game. 

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

  The highest bid is a number of tricks to take above six with a named
  suit or no-trumps.
  
  Requires:
  - `high_bid`
  - `not_passed`: The players that haven't yet passed.
  ```
  [state players action]
  (if (= action :null) (error {:error "action required"}))
  @{Handle the Bid Action}
)
---

@s

The first thing we do is check for the existence of the action
input. Generally speaking, Tamerlane is designed not to require too
much error handling and input validation from rules engines; it should
generally try to Do The Right Thing. That said, it might help with
development to add some basic error and input validation.

In the bidding phase, as in most other complex game phases that we
might want to represent, we need to be able to handle any input and
determine whether the phase is over, or whether it should continue by
returning a state with the same `phase` attribute.

In this case, we can reason that two things need to be true for the
auction to be over:

1. There is some high bidder;
2. Everyone else has passed.[^end-criteria]

[^end-criteria]: In a system where we were responsible for the error
handling and validation, we might want to validate that the high
bidder and the one person left in the set of not-passed players are
*the same player*. In this system, that constraint would only be
violated if the Tamerlane input system had a bug in it, and that's not
our responsibility.

This gives us the basic structure of the bid phase. We will determine
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)]
  # 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}
    # Otherwise, continue the bidding.
    @{Continue the Auction}
))
---

@s Bidding: New Meta

The `new-meta` function takes the existing state and the action and
computes the new metadata entry from it.

--- 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)
        # Record the high bid (whether it's a new bid or the existing high bid).
        [high-bid high-bidder] (case last-bid
                                 "pass" [previous-high-bid previous-high-bidder]
                                 [last-bid last-bidder])]
    @{:high_bid @{:player high-bidder :bid high-bid}}))
---

Conceptually, it's pretty straightforward: we assume the presence of a
`high_bid` attribute in the input state metadata. If the input action
was a pass, the new high bid is the same as the old high
bid. Otherwise, the new bid is the new high bid. If we had to actually
validate that the input *was* higher, this function would be a little
more complex, but we can assume that no illegal inputs were allowed by
the server.

@s Bidding: Initial Events

After we determine the new metadata, we generate the initial array of
events that we will emit. 

--- Initial Bidding Events
(defn- initial-events
  [{:meta {:high_bid {:bid previous-high-bid :player previous-high-bidder}}}
   {:value last-bid :player last-bidder}
   current-high-bid]
  (case last-bid
    "pass" @[(events/add-decoration last-bidder "bid_action" "passed")]
    (array/concat 
     (case previous-high-bidder
       nil @[]
       @[(events/clear-decoration previous-high-bidder "bid_action")])
     (events/add-decoration last-bidder "bid_action" "declarer")
     (events/add-decoration last-bidder "bid" (bids/to-text current-high-bid)))))
---

As we can see, these all have to do with managing the player
decorations that will be displayed by the game interface. 

@s Clear Decoration

The only new event type here is `add-decoration`.

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

There's very little to this---even less than to @{Events: Add Decoration}---but one point
that is hopefully apparent is the purpose of
the `name` field on the `add-decoration` struct: it allows us to refer
back to this value when specifying what to clear. 

@s Updating the Set of Not-Passed Players

The last piece of bookkeeping before we can determine whether to end
or continue the action is to manage the set of players still in the auction.

--- Update Not Passed
(defn- update-not-passed
  [{:meta {:not_passed not-passed}} {:value last-bid :player last-bidder}]
  (case last-bid
    # Handle a new pass. Mark the player as passed by removing them from the set.
    "pass" (put not-passed (keyword last-bidder) nil))
    not-passed)
---

@s Proceeding with the Auction

If (as will necessarily be the case for at least the first trip around
the table) the auction isn't over yet, there are two possible
states:

1. Three of the four players have passed and the last is yet to bid;
we should prompt them with the `bids/force-bid` call, which doesn't
include the option to pass.
2. We're in the middle of the auction. In that case, we should prompt
them with all the bids that are higher than the current high bid.

In both cases we include a prompt event. In the Tamerlane system there
is no concept of *turns*---any player who has an active prompt can act
and move the game state forward. In Bid Whist it's always exactly one
player's turn, but that's not a necessary limitation of the
system. We can emit prompts for multiple players at once.

--- 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"))
  # The auction isn't over; include the set of players still bidding in the metadata.
  [(merge state {:meta (put new-meta :not_passed not-passed)
                 # State: Bid -> Bid
                 :phase "bid"})
   (if (= 1 (length not-passed))
     # If no one has bid and all but one have passed, the dealer has to bid.
     (array/push events (events/pick1 "bid" next-bidder (bids/force-bid)))
     # Otherwise, move to the next bidder.
     (array/push events (events/pick1 "bid" next-bidder
                                       (bids/available-bids high-bid))))])
---

@s Ending the Auction

If the auction isn't still going, it must be over. In that case we
simply return an updated state that advances to the next phase---the
discard phase---making sure to include the new metadata with the
winning bid in it.

Finally, we prompt the high bidder to complete their bid. If they won
with a suit bid, that means they'll call the suit. If they
won with a notrumps bid, they'll call Uptown or Downtown.

--- End the Auction
[(merge state {:meta new-meta
               # State: Bid -> Discard
               :phase "discard"})
 # Bidder selects suit in a trumps bid or direction in a no-trumps bid.
 (array/push events (events/pick1 "bid" high-bidder (bids/second-bid high-bid)))]
---

@s bid.janet

This is all we need to run the entire bidding phase. We've realized it
as a recursive function, where the base case is moving to the next
phase, and the recursive case is returning a state in the same phase.

--- game/bid.janet
(import players)
(import bids)
(import events)

@{New Meta}
@{Initial Bidding Events}
@{Update Not Passed}
@{Main Bid Function}
---

@s Draw and Discard

After the bidder names their full contract, they pick up the undealt
kitty and then discard 6 cards.

--- game/discard.janet
(import events)
(import bids)

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

(defn discard-phase
  ```
  The bidder has named their full contract. 

  They pick up the kitty, and are then prompted to discard 6 cards.

  Expected metadata:
  - `high_bid`: The winning bid in the auction.
  Provides:
  - `bid`: The full bid for the hand. 
  ```
  [{:meta {:high_bid {:bid high-bid}}} players {:player bidder :value 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}}
        (array/concat
         (map |(events/clear-decoration ($0 :id) "bid") players)
         (map |(events/clear-decoration ($0 :id) "bid_action") players)
         (events/add-decoration bidder "high_bid" full-bid-text)
         (events/draw bidder 6)
         (events/prompt-discard bidder 6))]))
---

This phase is quite straightforward. The only new element is one new
event.

@s Prompt Discard

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

This is the second kind of prompt we've seen, after `prompt_select`
(available to us in this codebase via `events/pick1`). The player is
prompted to select `count` cards from their hand, which the server
will then discard for them.

The same principles apply here as for drawing cards; the deck and the
players' hands are managed by the server. In the next phase, when we
receive the game state from the server, whatever cards the player
selected will have already been removed from their hand.

@s The Beginning of Play

Once the declarer has discarded their six cards, they score one trick
and lead to the first trick.

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