~subsetpark/whist

3a46cf90a95f9653ddba8ac017988b674292c2af — Zach Smith 6 months ago 69ca04e
Integrate cards and players into lit
M cards.janet => cards.janet +48 -44
@@ 1,27 1,27 @@
(defmacro intern-cards! []
  # Easily generate card structs.
  (def suits {"D" "diamonds" "S" "spades" "C" "clubs" "H" "hearts"})
  (def ranks {"1" 1 "A" 1 "2" 2 "3" 3 "4" 4 "5" 5 "6" 6 "7" 7 "8" 8 "9" 9 "T" 10 "J" 11 "Q" 12 "K" 13})

  (var defs @[])
  (loop [suit :in ["D" "S" "C" "H"]
	 rank :in ["A" "2" "3" "4" "5" "6" "7" "8" "9" "T" "J" "Q" "K"]]
    (let [sym (symbol suit rank)]
      (array/push defs ~(def ,sym @{:suit ,(in suits suit) :rank ,(in ranks rank)}))))
  (loop [rank :in ["1" "2"]]
    (let [sym (symbol "J" rank)]
      (array/push defs ~(def ,sym @{:suit "joker" :rank ,(in ranks rank)}))))
  (do ;defs))

## cards.janet
## Card to Text
(defn to-text [{:suit suit :rank rank}]
  (case suit
    "joker" (case rank
	      2 "Big Joker"
	      1 "Little Joker")
    (let [suits {"diamonds" "♦" "spades" "♠" "clubs" "♣" "hearts" "♥"}
	    ranks {1 "Ace" 2 "2" 3 "3" 4 "4" 5 "5" 6 "6" 7 "7" 8 "8" 9 "9" 10 "10" 11 "J" 12 "Q" 13 "K"}]
	  ranks {1 "Ace"
		 2 "2"
		 3 "3"
		 4 "4"
		 5 "5"
		 6 "6"
		 7 "7"
		 8 "8"
		 9 "9"
		 10 "10"
		 11 "J"
		 12 "Q"
		 13 "K"}]
	(string (suits suit) (ranks rank)))))

## Of Suit or Off
(defn- of-suit
  "Return any cards in stack that match the led suit."
  [led-suit stack]


@@ 35,28 35,31 @@
			 (= "joker" ($0 :suit)))]
    (filter with-jokers stack)))

(defn- of-suit-or-trumps
  "Return any cards in stack that match the led suit, or are trumps."
  [led-suit trumps stack]
  (let [with-jokers-and-trumps
	|(or (= led-suit ($0 :suit))
	     (= trumps ($0 :suit))
	     (= "joker" ($0 :suit)))]
    (filter with-jokers-and-trumps stack)))
(defn of-suit-or-off
  "Return any cards in stack that match the led suit, otherwise return all cards."
  [led-suit current-bid stack]
  (let [on-suit (if (= led-suit (current-bid :suit))
		  # 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 just for cards of that suit.
		  (of-suit led-suit stack))]
    (if (> (length on-suit) 0) on-suit stack)))

## Enable Card Comparison
(defn- uptown [a b] (match [a b]
		    # `1` is the rank of the Ace.
		    @[1 1] 0
		    @[1 _] 1
		    @[_ 1] -1
		    @[x y] (compare x y)))
            # `1` is the rank of the Ace.
            @[1 1] 0
            @[1 _] 1
            @[_ 1] -1
            @[x y] (compare x y)))

(defn- downtown [a b] (match [a b]
		    # `1` is the rank of the Ace.
		    @[1 1] 0
		    @[1 _] 1
		    @[_ 1] -1
		    @[x y] (- (compare x y))))
            # `1` is the rank of the Ace.
            @[1 1] 0
            @[1 _] 1
            @[_ 1] -1
            @[x y] (- (compare x y))))

(defn- uptown-card [trumps]
  @{:compare (fn [self other]


@@ 105,16 108,15 @@
    (fn [card]
      (table/setproto card proto))))

(defn of-suit-or-off
  "Return any cards in stack that match the led suit, otherwise return all cards."
  [led-suit current-bid stack]
  (let [on-suit (if (= led-suit (current-bid :suit))
		  # 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 just for cards of that suit.
		  (of-suit led-suit stack))]
    (if (> (length on-suit) 0) on-suit stack)))
## High Card
(defn- of-suit-or-trumps
  "Return any cards in stack that match the led suit, or are trumps."
  [led-suit trumps stack]
  (let [with-jokers-and-trumps
	|(or (= led-suit ($0 :suit))
	     (= trumps ($0 :suit))
	     (= "joker" ($0 :suit)))]
    (filter with-jokers-and-trumps stack)))

(defn high-card
  "Trick resolution for all Bid Whist games."


@@ 129,3 131,5 @@
	 # Get the highest card according to each
	 # one's `:compare`.
	 (extreme compare>))))



M lit/events.lit => lit/events.lit +243 -0
@@ 1,3 1,5 @@
# Appendix I

@s Appendix: Bids

We can hardcode the list of possible bids and define a few functions


@@ 112,6 114,247 @@ Finally, if three out of four players pass, then the fourth player
@{Available Bids}
---

# Appendix II

@s Appendix: Cards

In Tamerlane, cards are represented in data as simple objects. They
have two attributes, `suit` and `rank`.

The definition of which cards are contained in any deck type is
currently stored on the Tamerlane server, and deck types are specified
by name. For instance, Bid Whist uses the `52JJ` deck, which is the
normal 52-card Anglo-French deck with two Jokers.

Our card logic is a crucial element of the game. This module encodes
the logic determining what can be legally played to a given trick, as
well as how to determine which card wins a given trick.

@s Representing Cards

The card ranks are encoded as integers in "standard" order, with Aces
represented with 1 up to Kings at 13.

--- Card to Text
(defn to-text [{:suit suit :rank rank}]
  (case suit
    "joker" (case rank
	      2 "Big Joker"
	      1 "Little Joker")
    (let [suits {"diamonds" "♦" "spades" "♠" "clubs" "♣" "hearts" "♥"}
	  ranks {1 "Ace"
		 2 "2"
		 3 "3"
		 4 "4"
		 5 "5"
		 6 "6"
		 7 "7"
		 8 "8"
		 9 "9"
		 10 "10"
		 11 "J"
		 12 "Q"
		 13 "K"}]
	(string (suits suit) (ranks rank)))))
---

@s Determining What Can Be Played

The rules of following suit in Bid Whist are fairly simple:

- If a player can follow suit, they must;
- Otherwise, they can play any card.

Our job is only somewhat complicated by the variable role of the
Joker. In a suited contract, Jokers behave as though they were members
of the trump suit. On the other hand, in a no-trumps contract, Jokers
are members of their own suit.

--- Of Suit or Off
(defn- of-suit
  "Return any cards in stack that match the led suit."
  [led-suit stack]
  (let [without-jokers |(= led-suit ($0 :suit))]
    (filter without-jokers stack)))

(defn- of-suit-or-jokers
  "Return any cards in stack that match the led suit, or are jokers."
  [led-suit stack]
  (let [with-jokers |(or (= led-suit ($0 :suit))
			 (= "joker" ($0 :suit)))]
    (filter with-jokers stack)))

(defn of-suit-or-off
  "Return any cards in stack that match the led suit, otherwise return all cards."
  [led-suit current-bid stack]
  (let [on-suit (if (= led-suit (current-bid :suit))
		  # 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 just for cards of that suit.
		  (of-suit led-suit stack))]
    (if (> (length on-suit) 0) on-suit stack)))
---

We can be a bit clever here by checking to see if the led suit is the
same as the suit of the contract, since `"notrumps"` is not the suit
of any card.

@s Determining the Winning Card

The other crucial element of our card logic is the function which
actually determines who takes a trick. In our play phase, we have
decorated each card with the player who played it. Thus, in this
module, we determine the highest card in the trick, and then back in
the play we can pull the winning player off of it.

--- High Card
(defn- of-suit-or-trumps
  "Return any cards in stack that match the led suit, or are trumps."
  [led-suit trumps stack]
  (let [with-jokers-and-trumps
	|(or (= led-suit ($0 :suit))
	     (= trumps ($0 :suit))
	     (= "joker" ($0 :suit)))]
    (filter with-jokers-and-trumps stack)))

(defn high-card
  "Trick resolution for all Bid Whist games."
  [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>))))
---

@s Compare-Enabled Cards

In this program, possibly the most idiomatic way to find the winning
card is to take advantage of some specific features of the Janet
language. In particular we're taking advantage of Janet's OO features
by defining some **prototype** cards with custom `compare` methods,
and then setting the right prototype for the cards we are comparing
according to the contract they're being evaluated under.

This arguably has more to do with the specifics of object-oriented
programming in Janet than anything having to do with the Tamerlane
system, so feel free to skip it if it's not of particular interest.

--- Enable Card Comparison
(defn- uptown [a b] (match [a b]
            # `1` is the rank of the Ace.
            @[1 1] 0
            @[1 _] 1
            @[_ 1] -1
            @[x y] (compare x y)))

(defn- downtown [a b] (match [a b]
            # `1` is the rank of the Ace.
            @[1 1] 0
            @[1 _] 1
            @[_ 1] -1
            @[x y] (- (compare x y))))

(defn- uptown-card [trumps]
  @{:compare (fn [self other]
	       (match [(self :suit) (other :suit)]
		 @["joker" "joker"] (compare (self :rank) (other :rank))
		 @["joker" _] 1
		 @[_ "joker"] -1
		 @[trumps trumps] (uptown (self :rank) (other :rank))
		 @[trumps _] 1
		 @[_ trumps] -1 
		 @[_ _] (uptown (self :rank) (other :rank))))})

(defn- downtown-card [trumps]
  @{:compare (fn [self other]
	       (match [(self :suit) (other :suit)]
		 @["joker" "joker"] (compare (self :rank) (other :rank))
		 @["joker" _] 1
		 @[_ "joker"] -1
		 @[trumps trumps] (downtown (self :rank) (other :rank))
		 @[trumps _] 1
		 @[_ trumps] -1 
		 @[_ _] (downtown (self :rank) (other :rank))) )})

(def- notrumps-card
  @{:compare (fn [self other]
	       (match [(self :suit) (other :suit)]
		 @["joker" "joker"] (compare (self :rank) (other :rank))
		 @["joker" _] -1
		 @[_ "joker"] 1
		 @[_ _] (uptown (self :rank) (other :rank))))})

(def- notrumps-downtown-card
  @{:compare (fn [self other]
	       (match [(self :suit) (other :suit)]
		 @["joker" "joker"] (compare (self :rank) (other :rank))
		 @["joker" _] -1
		 @[_ "joker"] 1
		 @[_ _] (downtown (self :rank) (other :rank))))})

(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
		@[trumps "up"] (uptown-card trumps)
		@[trumps "down"] (downtown-card trumps))]
    (fn [card]
      (table/setproto card proto))))
---

@s cards.janet

--- cards.janet
@{Card to Text}
@{Of Suit or Off}
@{Enable Card Comparison}
@{High Card}
---

# Appendix III

@s Appendix: Players

We need a little bit of business logic when it comes to handling
players. In particular, we need a way to easily select the "next"
player around the table, while optionally filtering out certain ones
(in the case of the auction, we want to filter out players who have
already passed).

In Janet we can do this using fibers.

--- players.janet
(defn next-player
  [id players &opt out-of]
  
  (var ind (find-index |(and (= ($0 :id) id)) players))
  (let [f (fiber/new (fn []
		       (while true
			 (do
			   (set ind (mod (inc ind) (length players)))
			   (yield ind)))))]
    (var found nil)
    (while (not found)
      (let [new-ind (resume f)
	    new-id ((players new-ind) :id)]
	(if (or (nil? out-of) (in out-of (keyword new-id)))
	  (set found new-id))))
    found))

(defn of-team [players team] (->> players
				  (filter |(= ($0 :team) team))
				  (map |($0 :id))))
---

# Appendix IIII

@s Appendix: All Events

--- events.janet

M players.janet => players.janet +2 -0
@@ 1,3 1,4 @@
## players.janet
(defn next-player
  [id players &opt out-of]
  


@@ 18,3 19,4 @@
(defn of-team [players team] (->> players
				  (filter |(= ($0 :team) team))
				  (map |($0 :id))))


M test/bid.janet => test/bid.janet +2 -1
@@ 4,8 4,9 @@
(import bids)
(import init)
(import cards)
(import ./support)

(cards/intern-cards!)
(support/intern-cards!)

(def- player-state [{:team "north_south" :id "North"}
		    {:team "east_west" :id "East"}

M test/cards.janet => test/cards.janet +4 -2
@@ 1,6 1,8 @@
(import testament :prefix "")
(import cards)
(cards/intern-cards!)
(import testament :prefix "")
(import ./support)

(support/intern-cards!)

(defn- is-card-sym?
  [sym]

M test/last-card.janet => test/last-card.janet +2 -2
@@ 3,9 3,9 @@
(import whist)
(import bids)
(import init)
(import cards)
(import ./support)

(cards/intern-cards!)
(support/intern-cards!)

(def- two-cards-left
  [{:hand [C2 CA] :team "north_south" :id "North"}

M test/lead.janet => test/lead.janet +2 -2
@@ 3,9 3,9 @@
(import whist)
(import bids)
(import init)
(import cards)
(import ./support)

(cards/intern-cards!)
(support/intern-cards!)
 
(def- players-with-full-hands
  # Discarded: Deuces + Jokers

M test/whist.janet => test/whist.janet +2 -2
@@ 4,9 4,9 @@
(import whist)
(import bids)
(import init)
(import cards)
(import ./support)

(cards/intern-cards!)
(support/intern-cards!)

(def- players ["North" "East" "South" "West"])


M whist.do => whist.do +2 -2
@@ 1,2 1,2 @@
redo-ifchange whist.lit
lit whist.lit
\ No newline at end of file
redo-ifchange whist.lit lit/events.lit
lit whist.lit

M whist.lit => whist.lit +4 -0
@@ 75,6 75,8 @@ The rules of the game, therefore, are realized in the **next state** step.
     |                       |                          |
---

## Game Logic

@s whist/next

The most important function that we need to implement when building a


@@ 1100,6 1102,8 @@ we can wrap up all the components into a single module.
@{Main Play Function}
---

## Supplementary Logic

@s Other Endpoints

We have implemented the entirety of our `/next` API, which contains