10 files changed, 311 insertions(+), 55 deletions(-)

M cards.janet
M lit/events.lit
M players.janet
M test/bid.janet
M test/cards.janet
M test/last-card.janet
M test/lead.janet
M test/whist.janet
M whist.do
M whist.lit

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

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

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

@@ 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"}

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

@@ 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"}

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

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

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

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