~subsetpark/whist

ref: 8fc382a6dce31cc91d6440c69bd07e137b29b63c whist/cards.janet -rw-r--r-- 4.5 KiB
8fc382a6 — Zach Smith Format all 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
## 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"}]
        (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]
  (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)))

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

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