Checkers
Computer;; warming the interpreter…
You
I built a Network Checkers game in high school. The source code is long-lost, but I have rebuilt it for you here using the same search engine as Chessmate.
- ;; The game's state: !game is its atom, which the commands that change it take first
- ;; Start a new game with these players, at once; Take Back goes back to the last one. Returns !game
- ;; Let the computer play both sides, in the game as it stands
- ;; Move from 23 to 19; a jump names every square it lands on, as (checkers/move! !game 22 15 6)
- ;; Let the computer think 2 s a move for White
- ;; Search 8 plies deep for White; 0 for no limit
- ;; Take back the last move, and the computer's reply to yours; with no move, go back to the last game
- ;; Go back to the game as it was after White's first move, as a click on a move does
- ;; Pause the computer; (checkers/resume! !game) goes on
- ;; Turn the board round
- ;; The legal moves: the jumps, when a side must jump
- ;; The board as text, Black's back rank first
- ;; The evaluation of this position, without searching
- ;; The position in FEN
- ;; Print the game as PDN
- ;; Start a new game from a position in FEN
- ;; The game, with what the computer is doing
- ;; Resign the game
The rules
- English draughts, which America calls checkers: 12 men a side on the 32 dark squares. White moves first here, as in chess, where English draughts has Black first
- A man steps one square diagonally forward; a king, one square diagonally either way
- A piece jumps an enemy piece beside it to the empty square beyond, taking it, and jumps again while it can, all in one move. Men jump forward only
- Whoever can jump must, choosing among the jumps, and must jump as far as the jump chosen goes
- A man that reaches the far row is crowned a king, and its move ends there
- A side with no move, its pieces all taken or blocked, loses. A position that occurs a third time, or forty moves each without a jump or a man moved, is a draw
;; drag a piece, or tap it and then its square; a jump by its last square, or square by square · ← ↑ → ↓ move on the board · Enter picks up and puts down · Esc puts down
The engine
- Chessmate 2026's search, on a Checkers board: a principal variation search with a transposition table, iterative deepening, killer moves, history and late move reductions
- At its horizon it plays out the jumps each side must make, and it searches a side's only move a ply deeper
- It thinks in a background worker, and plays stronger the longer it thinks
;; this engine:
Source
;; 7 namespaces, 2465 lines, as this machine runs them
checkers.board · 593 lines
(ns checkers.board
"The Checkers board, built for speed as Chessmate 2026's is (chessmate.v2.board): there is one
position, changed in place by make! and taken back by unmake!, and it lives in typed arrays
that the whole engine shares. The same board judges the game on the page, and the search plays
on it.
The rules are English draughts', which America calls checkers:
the board 8 × 8, played on its 32 dark squares, with a dark square in each player's
left-hand corner
the men 12 a side, Black's on squares 1 to 12 and White's on 21 to 32; White moves
first here, as in chess (owner, 2026-09-29: \"Computer should move first as
white\"), where English draughts has Black first
moving a man steps one square diagonally forward, onto an empty square; a king one
square diagonally either way
jumping a piece takes an enemy piece beside it by jumping over it to the empty square
beyond, and goes on jumping with the same piece while it can, all in one move;
a man jumps forward only, a king either way
forced jumps whoever can jump must, choosing among the jumps as they like, and must jump as
far as the jump they choose goes
crowning a man that reaches the far row is crowned a king, and its move ends there
the end a side with no move, its pieces all taken or blocked, loses; the game is drawn
when a position occurs for the third time, or after forty moves each without a
jump or a man moved
Squares are numbered 1 to 32, as players number them: 1 to 4 on Black's back rank, from White's
left, 5 to 8 on the next, and so on to 29 to 32 on White's. Inside, a square is its number less
one, 0 to 31, on a row from 0, Black's back rank, to 7, White's.
Pieces are a type, 1 for a man and 2 for a king, plus 8 for White's. Sides are 0 for Black and 1
for White.
Moves are numbers: the square a piece leaves, a flag for a jump, and the diagonals it takes, in
order (see move). The pieces a jump takes and the squares it lands on follow from them.
Alongside the pieces, the board keeps the position's Zobrist hash, in two 32-bit halves, and how
many men and kings each side has, both updated move by move."
(:require
[clojure.string :as str]))
;; Pieces and sides
(def ^:const man 1)
(def ^:const king 2)
(def ^:const white-piece 8) ; added to a type for White's piece
(def ^:const black 0)
(def ^:const white 1)
(defn kind "A piece's type: 1 for a man, 2 for a king." [piece] (bit-and piece 7))
(defn side-of "A piece's side: 0 for Black, 1 for White." [piece] (bit-shift-right piece 3))
(defn div
"a divided by b, truncated towards zero as quot does, for numbers within 32 bits. quot
compiles to a function call; this compiles to one division."
[a b]
(bit-or (/ a b) 0))
(defn larger "The larger of two numbers: max, which compiles to a function call, as a comparison." [a b] (if (> a b) a b))
(defn smaller "The smaller of two numbers, as min." [a b] (if (< a b) a b))
;; Squares, and the diagonals between them
(defn row-of "A square's row: 0 on Black's back rank, 7 on White's." [sq] (bit-shift-right sq 2))
(defn file-of
"A square's file, 0 to 7 from White's left: the dark squares are files 1, 3, 5 and 7 on Black's
back rank and every second row from it, and 0, 2, 4 and 6 on the others."
[sq]
(+ (* 2 (bit-and sq 3)) (if (zero? (bit-and (row-of sq) 1)) 1 0)))
(defn- square-at
"The dark square on file and row, or -1 off the board."
[file row]
(if (and (<= 0 file) (<= file 7) (<= 0 row) (<= row 7)) (+ (* row 4) (bit-shift-right file 1)) -1))
(defn crown-row "The row where side's men are crowned: the far one." [side] (if (zero? side) 7 0))
;; The four diagonals: 0 and 1 go towards Black's back rank, left and right as White sees them,
;; the way White's men go; 2 and 3 towards White's, the way Black's go. A king takes all four.
(def ^:private dx #js [-1 1 -1 1])
(def ^:private dy #js [-1 -1 1 1])
(def step "The square one step along each diagonal from each square, by square * 4 + diagonal, or -1." (js/Int8Array. 128))
(def leap "The square two steps along, where a jump over the step's square lands, or -1." (js/Int8Array. 128))
(dotimes [sq 32]
(dotimes [d 4]
(let [f (file-of sq)
r (row-of sq)]
(aset step (+ (* sq 4) d) (square-at (+ f (aget dx d)) (+ r (aget dy d))))
(aset leap (+ (* sq 4) d) (square-at (+ f (* 2 (aget dx d))) (+ r (* 2 (aget dy d))))))))
(defn- first-diagonal
"The first diagonal a piece may take: a king's, all four; a man's, forward only."
[piece]
(if (or (== (kind piece) king) (== (side-of piece) white)) 0 2))
(defn- end-diagonal "After the last." [piece] (if (or (== (kind piece) king) (== (side-of piece) black)) 4 2))
;; The position
(def squares "The piece on each square, or 0." (js/Int8Array. 32))
(def counts
"How many men and kings each side has: Black's men, Black's kings, White's men and White's kings."
(js/Int32Array. 4))
(defn- count-slot "Where a piece is counted in counts." [piece] (+ (* 2 (side-of piece)) (dec (kind piece))))
;; The state, as slots of one Int32Array
(def ^:const side-slot 0) ; the side to move
(def ^:const halfmove-slot 1) ; plies since the last jump or man's move
(def ^:const ply-slot 2) ; moves made since the position was set, which index the history
(def ^:const hash-lo-slot 3) ; the Zobrist hash, low half
(def ^:const hash-hi-slot 4) ; and high half
(def state "The side to move and the rest, by the slots above." (js/Int32Array. 5))
(defn side "The side to move." [] (aget state side-slot))
(def ^:const quiet-limit
"Plies without a jump or a man's move after which the game is drawn: forty moves each."
80)
;; The history: what each move changed, for unmake! and for the repetition test
(def ^:const undo-stride 10)
(def ^:const max-history 1024)
(def undo "Per move made, by ply-slot: the move and the state before it (see make!)." (js/Int32Array. (* max-history undo-stride)))
;; Zobrist keys: pieces at piece * 32 + square, the side at 352. Drawn from a fixed mulberry32
;; sequence, as Chessmate 2026's are, so that every runtime hashes alike.
(def ^:private zobrist-lo (js/Int32Array. 353))
(def ^:private zobrist-hi (js/Int32Array. 353))
(let [x (js/Int32Array. #js [0x2545F491])
next! (fn []
(let [a (bit-or (+ (aget x 0) 0x6D2B79F5) 0)
_ (aset x 0 a)
t (js/Math.imul (bit-xor a (unsigned-bit-shift-right a 15)) (bit-or a 1))
t (bit-xor t (+ t (js/Math.imul (bit-xor t (unsigned-bit-shift-right t 7)) (bit-or t 61))))]
(bit-or (bit-xor t (unsigned-bit-shift-right t 14)) 0)))]
(dotimes [i 353]
(aset zobrist-lo i (next!))
(aset zobrist-hi i (next!))))
(def ^:const side-key 352)
(defn- toggle! [k]
(aset state hash-lo-slot (bit-xor (aget state hash-lo-slot) (aget zobrist-lo k)))
(aset state hash-hi-slot (bit-xor (aget state hash-hi-slot) (aget zobrist-hi k))))
;; Putting pieces down and picking them up, keeping the hash and the counts
(defn- put!
"Place piece on the empty square sq."
[piece sq]
(let [c (count-slot piece)]
(aset squares sq piece)
(toggle! (+ (* piece 32) sq))
(aset counts c (inc (aget counts c)))))
(defn- lift!
"Take the piece off sq, and return it."
[sq]
(let [piece (aget squares sq)
c (count-slot piece)]
(aset squares sq 0)
(toggle! (+ (* piece 32) sq))
(aset counts c (dec (aget counts c)))
piece))
;; Moves:
;; bits 0 to 4 the square the piece leaves
;; bit 5 set for a jump
;; bits 6 on the diagonals it takes, two bits each, the first lowest, below a 1 that marks
;; where they end: a step takes one, a jump one for each piece it takes. Twelve
;; jumps, all a side's pieces, fit in 31 bits.
(def ^:const jump-flag 32)
(defn move
"The move of a piece from the square from, stepping or jumping, along n diagonals, the first
in the lowest two bits of diagonals."
[from ^boolean jump? diagonals n]
(bit-or from (if jump? jump-flag 0) (bit-shift-left (bit-or diagonals (bit-shift-left 1 (* 2 n))) 6)))
(defn move-from [m] (bit-and m 31))
(defn ^boolean jump? [m] (not (zero? (bit-and m jump-flag))))
(defn- route "A move's diagonals, above their end marker." [m] (unsigned-bit-shift-right m 6))
(defn jumps "How many pieces a move takes." [m] (if (jump? m) (bit-shift-right (- 31 (js/Math.clz32 (route m))) 1) 0))
(defn first-diagonal-of "The diagonal a move takes first." [m] (bit-and (route m) 3))
(defn move-to
"Where a move's piece ends up."
[m]
(let [hops (if (jump? m) leap step)]
(loop [sq (move-from m)
r (route m)]
(if (== r 1) sq (recur (aget hops (+ (* sq 4) (bit-and r 3))) (unsigned-bit-shift-right r 2))))))
(defn landings
"The squares a move's piece stands on: where it starts, then where each step or jump lands."
[m]
(let [hops (if (jump? m) leap step)]
(loop [sq (move-from m)
r (route m)
out [sq]]
(if (== r 1)
out
(let [to (aget hops (+ (* sq 4) (bit-and r 3)))]
(recur to (unsigned-bit-shift-right r 2) (conj out to)))))))
(defn taken
"The squares of the pieces a move takes, in the order it takes them."
[m]
(if (jump? m)
(loop [sq (move-from m)
r (route m)
out []]
(if (== r 1)
out
(let [i (+ (* sq 4) (bit-and r 3))]
(recur (aget leap i) (unsigned-bit-shift-right r 2) (conj out (aget step i))))))
[]))
(defn ^boolean crowns?
"Does move m crown the man that makes it, in the position on the board?"
[m]
(let [piece (aget squares (move-from m))]
(and (== (kind piece) man) (== (row-of (move-to m)) (crown-row (side-of piece))))))
;; Generating moves
(def ^:private cursor "Where generate! writes the next move, and the square the jumping piece left." (js/Int32Array. 2))
(defn- emit! [out m]
(let [n (aget cursor 0)]
(aset out n m)
(aset cursor 0 (inc n))))
(defn- ^boolean jump-on!
"Write into out every jump that piece, lifted off the board, can make on from sq, where it
stands after n jumps along diagonals: each jump that cannot go on, or that crowns a man, is a
move. The pieces it takes are lifted off meanwhile, so that none is jumped twice. Returns
whether it could jump at all."
[out piece sq diagonals n]
(let [them (bit-xor (side-of piece) 1)
end (end-diagonal piece)
crowning (if (== (kind piece) man) (crown-row (side-of piece)) -1)]
(loop [d (first-diagonal piece)
jumped false]
(if (< d end)
(let [i (+ (* sq 4) d)
to (aget leap i)]
(if (and (>= to 0) (zero? (aget squares to)))
(let [over (aget step i)
victim (aget squares over)]
(if (and (not (zero? victim)) (== (side-of victim) them))
(let [diagonals (bit-or diagonals (bit-shift-left d (* 2 n)))]
(aset squares over 0)
(when (or (== (row-of to) crowning) (not (jump-on! out piece to diagonals (inc n))))
(emit! out (move (aget cursor 1) true diagonals (inc n))))
(aset squares over victim)
(recur (inc d) true))
(recur (inc d) jumped)))
(recur (inc d) jumped)))
jumped))))
(defn generate!
"Write the side to move's moves into out from index start, and return the index after the
last: its jumps, if it has any, as it must jump, and else its steps. With jumps-only?, only its
jumps, and none when it has none, for the quiescence search."
[out start ^boolean jumps-only?]
(let [us (aget state side-slot)]
(aset cursor 0 start)
(dotimes [sq 32]
(let [piece (aget squares sq)]
(when (and (not (zero? piece)) (== (side-of piece) us))
(aset cursor 1 sq)
(aset squares sq 0) ; the jumping piece leaves its square, which a king may land on again
(jump-on! out piece sq 0 0)
(aset squares sq piece))))
(when (and (== (aget cursor 0) start) (not jumps-only?))
(dotimes [sq 32]
(let [piece (aget squares sq)]
(when (and (not (zero? piece)) (== (side-of piece) us))
(let [end (end-diagonal piece)]
(loop [d (first-diagonal piece)]
(when (< d end)
(let [to (aget step (+ (* sq 4) d))]
(when (and (>= to 0) (zero? (aget squares to)))
(emit! out (move sq false d 1))))
(recur (inc d)))))))))
(aget cursor 0)))
(defn ^boolean can-step?
"Has the side to move a step, a move that jumps nothing? With no jump and no step, it has lost."
[]
(let [us (aget state side-slot)]
(loop [sq 0]
(if (< sq 32)
(let [piece (aget squares sq)]
(if (and (not (zero? piece)) (== (side-of piece) us)
(let [end (end-diagonal piece)]
(loop [d (first-diagonal piece)]
(if (< d end)
(let [to (aget step (+ (* sq 4) d))]
(if (and (>= to 0) (zero? (aget squares to))) true (recur (inc d))))
false))))
true
(recur (inc sq))))
false))))
;; Making and unmaking moves
(defn make!
"Play move m, which generate! made for this position. The history keeps what unmake! needs:
the move, which of the pieces it takes are kings, the piece that moves, the halfmove count, the
hash and the counts of pieces."
[m]
(let [from (bit-and m 31)
jump? (not (zero? (bit-and m jump-flag)))
u (* (aget state ply-slot) undo-stride)
piece (aget squares from)
us (side-of piece)]
(aset undo u m)
(aset undo (+ u 2) piece)
(aset undo (+ u 3) (aget state halfmove-slot))
(aset undo (+ u 4) (aget state hash-lo-slot))
(aset undo (+ u 5) (aget state hash-hi-slot))
(aset undo (+ u 6) (aget counts 0))
(aset undo (+ u 7) (aget counts 1))
(aset undo (+ u 8) (aget counts 2))
(aset undo (+ u 9) (aget counts 3))
(lift! from)
(loop [sq from
r (unsigned-bit-shift-right m 6)
i 0
kings 0]
(if (== r 1)
(do (aset undo (+ u 1) kings)
(put! (if (and (== (kind piece) man) (== (row-of sq) (crown-row us))) (+ piece 1) piece) sq))
(let [k (+ (* sq 4) (bit-and r 3))]
(if jump?
(let [victim (lift! (aget step k))]
(recur (aget leap k) (unsigned-bit-shift-right r 2) (inc i)
(if (== (kind victim) king) (bit-or kings (bit-shift-left 1 i)) kings)))
(recur (aget step k) (unsigned-bit-shift-right r 2) (inc i) kings)))))
(aset state halfmove-slot (if (or jump? (== (kind piece) man)) 0 (inc (aget state halfmove-slot))))
(toggle! side-key)
(aset state side-slot (bit-xor us 1))
(aset state ply-slot (inc (aget state ply-slot)))))
(defn unmake!
"Take back the last move make! played: the pieces it took are put back along its path, and the
hash, the counts and the halfmove count restored from the history."
[]
(let [h (dec (aget state ply-slot))
u (* h undo-stride)
m (aget undo u)
kings (aget undo (+ u 1))
piece (aget undo (+ u 2))
from (bit-and m 31)
jump? (not (zero? (bit-and m jump-flag)))
them (* white-piece (bit-xor (side-of piece) 1))]
(loop [sq from
r (unsigned-bit-shift-right m 6)
i 0]
(if (== r 1)
(do (aset squares sq 0)
(aset squares from piece))
(let [k (+ (* sq 4) (bit-and r 3))]
(if jump?
(do (aset squares (aget step k) (+ them (if (zero? (bit-and kings (bit-shift-left 1 i))) man king)))
(recur (aget leap k) (unsigned-bit-shift-right r 2) (inc i)))
(recur (aget step k) (unsigned-bit-shift-right r 2) (inc i))))))
(aset state side-slot (side-of piece))
(aset state ply-slot h)
(aset state halfmove-slot (aget undo (+ u 3)))
(aset state hash-lo-slot (aget undo (+ u 4)))
(aset state hash-hi-slot (aget undo (+ u 5)))
(aset counts 0 (aget undo (+ u 6)))
(aset counts 1 (aget undo (+ u 7)))
(aset counts 2 (aget undo (+ u 8)))
(aset counts 3 (aget undo (+ u 9)))))
;; Draws the search can see
(defn ^boolean repetition?
"Has the position occurred before, since the last jump or man's move? Only kings' moves can
repeat a position. Positions before the search's root count too: the game's history is played
onto the board first."
[]
(let [h (aget state ply-slot)
lo (aget state hash-lo-slot)
hi (aget state hash-hi-slot)
oldest (larger 0 (- h (aget state halfmove-slot)))]
(loop [i (- h 2)]
(if (< i oldest)
false
(let [u (* i undo-stride)]
(if (and (== lo (aget undo (+ u 4))) (== hi (aget undo (+ u 5))))
true
(recur (- i 2))))))))
;; Positions from and to FEN, as Portable Draughts Notation writes them
(def standard-start
"The position every game starts from: Black's men on 1 to 12, White's on 21 to 32, White to move."
"W:W21,22,23,24,25,26,27,28,29,30,31,32:B1,2,3,4,5,6,7,8,9,10,11,12")
(def english-start
"English draughts' own start, the same men with Black to move: the one a PDN reader assumes
without a FEN."
"B:W21,22,23,24,25,26,27,28,29,30,31,32:B1,2,3,4,5,6,7,8,9,10,11,12")
(defn- fen-error [fen why] (js/Error. (str "Not a position: " why " (" fen ")")))
(defn- read-squares
"The squares a FEN's list of one side's pieces names, as [square king?]: numbers, ranges such
as 1-12, and a K before a king's square."
[fen text]
(for [item (str/split text #",")
:when (not (str/blank? item))
:let [[_ k a b] (or (re-matches #"\s*(K?)(\d{1,2})(?:-(\d{1,2}))?\s*" item)
(throw (fen-error fen (str "no square in " (pr-str item)))))
a (js/parseInt a 10)
b (if b (js/parseInt b 10) a)]
n (range a (inc b))]
(if (<= 1 n 32)
[(dec n) (= k "K")]
(throw (fen-error fen (str "there is no square " n))))))
(defn read-fen
"The position a FEN names, such as \"B:W21,22,23,24,25,26,27,28,29,30,31,32:B1,2,3,4,5,6,7,8,9,10,11,12\":
the side to move, B or W, then each side's pieces by square, W's and B's, a king's with a K
before it, and a range of squares, such as 1-12, for several. Returns {:side 0 or 1 :pieces
{square piece}}. Throws with the reason when it names no position a game can reach: a square
twice, more than 12 pieces a side, a man on the row it would have been crowned on, or no piece
for the side that has just moved."
[fen]
(let [text (str/replace (str/trim (str fen)) #"\.$" "")
[turn & lists] (str/split text #":")
side ({"B" black "W" white} (str/upper-case (str/trim (or turn ""))))
_ (when (nil? side) (throw (fen-error fen "the side to move is B or W")))
pieces (reduce (fn [pieces l]
(let [l (str/trim l)
colour ({"W" white "B" black} (str/upper-case (subs l 0 1)))]
(when (nil? colour) (throw (fen-error fen (str "a list of pieces starts with W or B: " (pr-str l)))))
(reduce (fn [pieces [sq king?]]
(when (contains? pieces sq) (throw (fen-error fen (str "square " (inc sq) " is named twice"))))
(when (and (not king?) (== (row-of sq) (crown-row colour)))
(throw (fen-error fen (str "a man on " (inc sq) " would have been crowned"))))
(assoc pieces sq (+ (if king? king man) (* colour white-piece))))
pieces
(read-squares fen (subs l 1)))))
{}
(remove str/blank? lists))
of (fn [s] (count (filter #(== s (side-of %)) (vals pieces))))]
(cond (> (of black) 12) (throw (fen-error fen "Black has more than 12 pieces"))
(> (of white) 12) (throw (fen-error fen "White has more than 12 pieces"))
(zero? (of (bit-xor side 1))) (throw (fen-error fen "the side that has just moved has no pieces"))
:else {:side side :pieces pieces})))
(defn- clear! []
(.fill squares 0)
(.fill counts 0)
(.fill state 0))
(defn set-position!
"Set the board to the position a FEN names, which read-fen checks. The history is emptied, and
no jump or man's move is counted before it."
[fen]
(let [{:keys [side pieces]} (read-fen fen)]
(clear!)
(doseq [[sq piece] pieces] (put! piece sq))
(when (== side white)
(aset state side-slot white)
(toggle! side-key))))
(defn fen
"The position in FEN: the side to move, then White's pieces and Black's, each side's in the
order of their squares."
[]
(let [of (fn [s] (str/join "," (for [sq (range 32)
:let [piece (aget squares sq)]
:when (and (not (zero? piece)) (== s (side-of piece)))]
(str (when (== (kind piece) king) "K") (inc sq)))))]
(str (if (zero? (side)) "B" "W") ":W" (of white) ":B" (of black))))
;; The moves as players write them
(defn notation
"A move as players write it: a step as its two squares with a dash, 11-15; a jump as the
squares it lands on, from where it starts, with an x, 22x15, or 22x15x6 for two pieces taken."
[m]
(str/join (if (jump? m) "x" "-") (map inc (landings m))))
(def ^:private scratch (js/Int32Array. 256))
(defn legal-moves
"The side to move's moves, in the order generate! makes them. A jump that takes the same pieces
as one before it and ends where it does, by another way round, is the same move, and is left
out."
[]
(let [end (generate! scratch 0 false)]
(loop [i 0
seen #{}
found []]
(if (< i end)
(let [m (aget scratch i)
k (if (jump? m) [(move-from m) (move-to m) (sort (taken m))] m)]
(if (contains? seen k)
(recur (inc i) seen found)
(recur (inc i) (conj seen k) (conj found m))))
found))))
(defn ^boolean has-move?
"Has the side to move a move? Without one, it has lost."
[]
(pos? (generate! scratch 0 false)))
(defn steps
"The side to move's steps, whether or not it must jump instead: for the page to say why a step
is refused."
[]
(let [us (aget state side-slot)]
(vec (for [sq (range 32)
:let [piece (aget squares sq)]
:when (and (not (zero? piece)) (== (side-of piece) us))
d (range (first-diagonal piece) (end-diagonal piece))
:let [to (aget step (+ (* sq 4) d))]
:when (and (>= to 0) (zero? (aget squares to)))]
(move sq false d 1)))))
(defn moves-by
"The legal moves the squares a player names can mean, numbers from 1: where the piece starts
and every square it lands on, or where it starts and where it ends."
[numbers]
(let [squares (mapv dec numbers)]
(filterv (fn [m]
(let [path (landings m)]
(or (= path squares)
(and (== 2 (count squares)) (= (first path) (first squares)) (= (peek path) (peek squares))))))
(legal-moves))))
(defn parse-move
"The legal moves a move written as players write it can mean: 11-15, 22x15, 22x15x6, or 22x6
for the jump from 22 that ends on 6. Squares may be joined by a dash, an x or a space."
[text]
(let [parts (str/split (str/trim (str/lower-case (str text))) #"\s*[-x\s]\s*")]
(if (and (<= 2 (count parts)) (every? #(re-matches #"\d{1,2}" %) parts))
(moves-by (map #(js/parseInt % 10) parts))
[])))
(defn threatened
"The squares of the side to move's pieces that the other side could jump, were it the other
side's move: what Show Threats marks."
[]
(let [us (aget state side-slot)]
(aset state side-slot (bit-xor us 1))
(let [end (generate! scratch 0 true)
found (into (sorted-set) (mapcat #(taken (aget scratch %))) (range end))]
(aset state side-slot us)
(vec found))))
(defn- perft-from [buffer depth start]
(let [end (generate! buffer start false)]
(if (== depth 1)
(- end start)
(loop [i start
nodes 0]
(if (< i end)
(let [m (aget buffer i)]
(make! m)
(let [n (perft-from buffer (dec depth) end)]
(unmake!)
(recur (inc i) (+ nodes n))))
nodes)))))
(defn perft
"How many move sequences of depth moves the position has: the move generator's test."
[depth]
(if (zero? depth) 1 (perft-from (js/Int32Array. (* 256 depth)) depth 0)))checkers.eval · 116 lines
(ns checkers.eval
"What a Checkers position is worth to the side to move, in hundredths of a man: a man is 100.
Material first, a king worth more than a man, and more still as the board empties and it has
room to use its reach. Then what the pieces' squares say:
advancement a man is worth more the nearer it is to being crowned: a little in the
middlegame, where the men hold together, and much more in the endgame
the centre men on the four squares in the middle of the board, 14, 15, 18 and 19, and
kings the further they are from the edges, where they reach most
the back rank men left on their own back rank guard it against the other side's crowning,
the two that players call the bridge most of all, while the other side has men
to crown
the endgame the side a man or more ahead is drawn to trade pieces and to bring its kings
at the other side's pieces; the side behind to shelter its kings in the double
corners
Every term but the endgame's is a middlegame and an endgame value, blended by how many pieces
are left, as Chessmate 2026's evaluation blends its (chessmate.v2.eval): 24 pieces is all
middlegame, and none all endgame."
(:require
[checkers.board :as board]))
(def ^:const man-value 100)
(def ^:const king-mg 125) ; a king in the middlegame
(def ^:const king-eg 150) ; and in the endgame
(def ^:private advance-mg "A man's worth by the rows it has advanced, 0 to 6, in the middlegame." (js/Int32Array. #js [0 1 2 3 5 7 9]))
(def ^:private advance-eg "And in the endgame." (js/Int32Array. #js [0 4 8 13 19 26 34]))
(def ^:private centre-man "A man's worth for its square, in the middlegame: 14, 15, 18 and 19." (js/Int32Array. 32))
(def ^:private centre-king "A king's, by how far its square is from the edges." (js/Int32Array. 32))
(doseq [n [14 15 18 19]] (aset centre-man (dec n) 5))
(dotimes [sq 32]
(let [f (board/file-of sq)
r (board/row-of sq)]
(aset centre-king sq (* 2 (+ (board/smaller f (- 7 f)) (board/smaller r (- 7 r)))))))
(def ^:private bridge "The bridge, by side: Black's 1 and 3, and White's 30 and 32." #js [#js [0 2] #js [29 31]])
(defn- ^boolean double-corner? "Is sq in a double corner, on 1 or 5, or on 28 or 32?" [sq] (or (== sq 0) (== sq 4) (== sq 27) (== sq 31)))
(def ^:private acc "The positional terms while evaluating: middlegame and endgame, White's less Black's." (js/Int32Array. 2))
(defn- add! [sign mg eg]
(aset acc 0 (+ (aget acc 0) (* sign mg)))
(aset acc 1 (+ (aget acc 1) (* sign eg))))
(defn- blend "A middlegame and an endgame value, weighed by how many pieces are left." [mg eg pieces] (board/div (+ (* mg pieces) (* eg (- 24 pieces))) 24))
(defn- steps-apart
"How many king's steps apart two squares are on an empty board: each diagonal step changes the
file and the row by one, so the larger difference."
[a b]
(board/larger (js/Math.abs (- (board/file-of a) (board/file-of b))) (js/Math.abs (- (board/row-of a) (board/row-of b)))))
(defn- nearest
"How many steps from sq the nearest of side's pieces is, on an empty board: 8 when it has none."
[sq side]
(loop [i 0
best 8]
(if (< i 32)
(let [p (aget board/squares i)]
(recur (inc i) (if (and (not (zero? p)) (== (board/side-of p) side)) (board/smaller best (steps-apart sq i)) best)))
best)))
(defn- endgame
"The endgame's terms, White's less Black's, with ten pieces or fewer, when a side is a man or
more ahead by material, lead: trading, the leader's kings drawn towards the other side's pieces,
and the other side's kings to the double corners."
[lead pieces]
(if (or (> pieces 10) (< (js/Math.abs lead) man-value))
0
(let [ahead (if (pos? lead) board/white board/black)
sign (if (pos? lead) 1 -1)]
(loop [sq 0
score (board/div (* lead (- 24 pieces)) 48)]
(if (< sq 32)
(let [p (aget board/squares sq)]
(recur (inc sq)
(cond (or (zero? p) (not (== (board/kind p) board/king))) score
(== (board/side-of p) ahead) (- score (* sign 3 (nearest sq (bit-xor ahead 1))))
(double-corner? sq) (- score (* sign 8))
:else score)))
score)))))
(defn evaluate
"The position's worth to the side to move, in hundredths of a man."
[]
(let [bm (aget board/counts 0)
bk (aget board/counts 1)
wm (aget board/counts 2)
wk (aget board/counts 3)
pieces (+ bm bk wm wk)
king-value (blend king-mg king-eg pieces)
material (- (+ (* wm man-value) (* wk king-value)) (+ (* bm man-value) (* bk king-value)))]
(aset acc 0 0)
(aset acc 1 0)
(dotimes [sq 32]
(let [p (aget board/squares sq)]
(when-not (zero? p)
(let [white? (== (board/side-of p) board/white)
sign (if white? 1 -1)]
(if (== (board/kind p) board/king)
(add! sign (aget centre-king sq) (aget centre-king sq))
(let [advanced (if white? (- 7 (board/row-of sq)) (board/row-of sq))
;; the back rank guards against the other side's men only: its kings are crowned already
guard (if (or (pos? advanced) (zero? (if white? bm wm)))
0
(let [b (aget bridge (board/side-of p))]
(if (or (== sq (aget b 0)) (== sq (aget b 1))) 9 3)))]
(add! sign (+ (aget advance-mg advanced) (aget centre-man sq) guard) (aget advance-eg advanced))))))))
(let [score (+ material (blend (aget acc 0) (aget acc 1) pieces) (endgame material pieces))]
(if (zero? (board/side)) (- 0 score) score))))checkers.search · 472 lines
(ns checkers.search
"The search that plays Checkers: Chessmate 2026's (chessmate.v2.search), step for step where the
two games agree, on the Checkers board. It is negamax, each side maximising the negation of the
other's score, with alpha-beta cutoffs, and these of the techniques Chessmate uses:
principal variation search the first move with the full window, the rest with a null
window, searched again only if they beat it
transposition table positions met before, by Zobrist hash, with their scores,
depths and best moves
iterative deepening depth 1, 2, 3, ... until the time is spent, each iteration
ordering the next, within an aspiration window
quiescence search at the horizon, the jumps each side must make, until neither
has one, so that no exchange is cut off half way
move ordering the table's move, jumps by how many pieces they take, killer
moves, and the history of quiet moves that caused cutoffs
reductions late move reductions, and internal iterative reduction
extensions a forced move, a side's only one, is searched a ply deeper, as
Chessmate searches a check
draws repetition, and forty moves each without a jump or a man moved
What chess needs and Checkers does not is left out: the null move, which the zugzwangs common in
Checkers make unsound, and the pruning that rests on the evaluation standing in for a move, as
a side that can jump must; the static exchange evaluation, as every jump is forced; and the
checks.
Scores are in hundredths of a man, for the side to move. A win in n plies, the other side left
without a move, is mate - n, the number Chessmate gives a mate."
(:require
[checkers.board :as board]
[checkers.eval :as eval]))
(def ^:const infinity 32000)
(def ^:const mate 31000)
(def ^:const mate-bound 30000) ; any score beyond this is a win or a loss
(def ^:const max-ply 96)
(def ^:const max-moves 256)
;; Bounds, as the transposition table records them
(def ^:const upper 1) ; the score is at most this: every move failed low
(def ^:const lower 2) ; at least this: a move failed high
(def ^:const exact 3)
;; The search's state, in typed arrays, as the board's is
(def ^:private moves "Each ply's moves, from ply * max-moves." (js/Int32Array. (* max-ply max-moves)))
(def ^:private scores "The moves' ordering scores." (js/Int32Array. (* max-ply max-moves)))
(def ^:private quiets "Each ply's quiet moves tried, from ply * 64, for the history's malus." (js/Int32Array. (* max-ply 64)))
(def ^:private killers "Two quiet moves per ply that caused cutoffs there." (js/Int32Array. (* max-ply 2)))
(def ^:private history "Quiet moves' success, by side * 128 + from * 4 + diagonal." (js/Int32Array. 256))
(def ^:private pv "The principal variation from each ply, from ply * max-ply." (js/Int32Array. (* max-ply max-ply)))
(def ^:private pv-length "Where each ply's variation ends." (js/Int32Array. max-ply))
(def ^:const stopped-slot 0)
(def ^:const seldepth-slot 1)
(def ^:const generation-slot 2)
(def ^:const mask-slot 3)
(def ^:const contempt-slot 4)
(def ^:const root-move-slot 5) ; the best root move of the iteration under way, once one is known
(def ^:const root-score-slot 6) ; and its score
(def ^:const ply-limit-slot 7) ; the deepest ply any line may reach, the jumps followed included
(def ^:private si (js/Int32Array. 8))
(def ^:const nodes-slot 0)
(def ^:const hard-slot 1) ; the clock's reading at which the search stops
(def ^:const max-nodes-slot 2)
(def ^:private sf (js/Float64Array. 3))
(def ^:private tables "The transposition table, allocated by the first search that needs it." #js [nil])
(def ^:private clock "The clock, a function of no arguments returning milliseconds." #js [nil])
(def ^:private lmr
"Late move reductions, by depth * 64 + the move's number: more for later moves and deeper
searches."
(let [t (js/Int32Array. 4096)]
(dotimes [d 64]
(dotimes [n 64]
(when (and (pos? d) (pos? n))
(aset t (+ (* d 64) n) (js/Math.floor (+ 0.75 (/ (* (js/Math.log d) (js/Math.log n)) 2.25)))))))
t))
;; The transposition table: four 32-bit numbers per entry, indexed by the hash's low half:
;; the hash's high half, to tell positions apart
;; the best move
;; the score, in the low 16 bits
;; the depth + 1 (8 bits), the bound (2 bits) and the search's generation
(defn resize!
"Give the transposition table 2^bits entries of 16 bytes each: 20 bits is 16 MB."
[bits]
(aset tables 0 (js/Int32Array. (* 4 (bit-shift-left 1 bits))))
(aset si mask-slot (dec (bit-shift-left 1 bits))))
(defn table? "Has the transposition table been allocated?" [] (some? (aget tables 0)))
(defn clear!
"Forget everything learnt: the table, the history and the killers."
[]
(when (aget tables 0) (.fill (aget tables 0) 0))
(.fill history 0)
(.fill killers 0))
(defn- to-table
"A score for the table: a win counted from this position, not from the root."
[score ply]
(cond (>= score mate-bound) (+ score ply)
(<= score (- mate-bound)) (- score ply)
:else score))
(defn- from-table [score ply]
(cond (>= score mate-bound) (- score ply)
(<= score (- mate-bound)) (+ score ply)
:else score))
(defn- store!
"Record a search's result for the position on the board. A deeper result for another position
is kept unless it is from an earlier search."
[depth bound score m ply]
(let [tt (aget tables 0)
hi (aget board/state board/hash-hi-slot)
e (* 4 (bit-and (aget board/state board/hash-lo-slot) (aget si mask-slot)))
info (aget tt (+ e 3))
generation (aget si generation-slot)
same? (== (aget tt e) hi)]
(when (or (zero? info)
(not (== (bit-shift-right info 10) generation))
(== bound exact)
(>= (+ depth 3) (dec (bit-and info 255))))
(aset tt e hi)
(when (or (not same?) (not (zero? m))) (aset tt (+ e 1) m))
(aset tt (+ e 2) (bit-and (to-table score ply) 0xFFFF))
(aset tt (+ e 3) (bit-or (inc depth) (bit-shift-left bound 8) (bit-shift-left generation 10))))))
;; Counting nodes, and the clock
(defn- count-node!
"One more node; every 256 a look at the clock and the node limit."
[]
(let [n (inc (aget sf nodes-slot))]
(aset sf nodes-slot n)
(when (and (zero? (bit-and n 255))
(or (>= n (aget sf max-nodes-slot)) (> ((aget clock 0)) (aget sf hard-slot))))
(aset si stopped-slot 1))))
(defn- ^boolean stopped? [] (not (zero? (aget si stopped-slot))))
(defn- draw-score
"A draw, as the side to move at ply sees it: the side to move at the root values it at
-contempt, so that it plays on in level positions."
[ply]
(if (zero? (bit-and ply 1)) (- (aget si contempt-slot)) (aget si contempt-slot)))
;; Move ordering
(defn- history-index
"Where a quiet move's history is kept: its side, its square and the diagonal it steps along."
[us m]
(+ (* us 128) (* (board/move-from m) 4) (board/first-diagonal-of m)))
(defn- move-score
"How promising m looks, for ordering: the table's move first, then jumps, the more pieces they
take the better, and a jump that crowns first among equals; then a man's step to be crowned,
then killer moves, then quiet moves by their history."
[m tt-move k1 k2 us]
(cond (== m tt-move) 30000000
(board/jump? m) (+ 20000000 (* 1000 (board/jumps m)) (if (board/crowns? m) 500 0))
(board/crowns? m) 19000000
(== m k1) 15000000
(== m k2) 14000000
:else (aget history (history-index us m))))
(defn- score-moves! [base end tt-move ply]
(let [us (board/side)
k1 (aget killers (* ply 2))
k2 (aget killers (inc (* ply 2)))]
(loop [i base]
(when (< i end)
(aset scores i (move-score (aget moves i) tt-move k1 k2 us))
(recur (inc i))))))
(defn- pick!
"The best-scored move from place i to end, swapped into place i."
[i end]
(loop [j (inc i)
best i]
(if (< j end)
(recur (inc j) (if (> (aget scores j) (aget scores best)) j best))
(let [m (aget moves best)
s (aget scores best)]
(aset moves best (aget moves i))
(aset scores best (aget scores i))
(aset moves i m)
(aset scores i s)
m))))
(defn- reward!
"A quiet move m caused a cutoff at ply: make it a killer, raise its history and lower that of
the quiet moves tried before it. The history saturates at +-16,384."
[m ply depth n-quiets]
(let [us (board/side)
bonus (board/smaller 1600 (* 16 depth depth))
k (* ply 2)]
(when-not (== m (aget killers k))
(aset killers (inc k) (aget killers k))
(aset killers k m))
(let [i (history-index us m)
h (aget history i)]
(aset history i (+ h (- bonus (board/div (* h bonus) 16384)))))
(dotimes [j n-quiets]
(let [q (aget quiets (+ (* ply 64) j))]
(when-not (== q m)
(let [i (history-index us q)
h (aget history i)]
(aset history i (- h bonus (board/div (* h bonus) 16384)))))))))
(defn- new-pv!
"m is the best move at ply so far: the variation from ply is m, then the child's."
[m ply]
(let [row (* ply max-ply)
child (* (inc ply) max-ply)
end (aget pv-length (inc ply))]
(aset pv (+ row ply) m)
(loop [i (inc ply)]
(when (< i end)
(aset pv (+ row i) (aget pv (+ child i)))
(recur (inc i))))
(aset pv-length ply (board/larger end (inc ply)))))
;; The quiescence search
(defn- quiesce
"The score of the position once the jumps are played out. A side that can jump must, so it
cannot stand on its evaluation while it has a jump: the jumps are searched until a side has
none, and there the evaluation is the score, unless that side cannot even step, and has lost."
[alpha beta ply]
(aset pv-length ply ply)
(count-node!)
(when (> ply (aget si seldepth-slot)) (aset si seldepth-slot ply))
(if (>= ply (aget si ply-limit-slot))
(eval/evaluate)
(let [base (* ply max-moves)
end (board/generate! moves base true)]
(if (== end base)
(if (board/can-step?) (eval/evaluate) (+ (- mate) ply))
(do (score-moves! base end 0 ply)
(loop [i base
alpha alpha
best (- infinity)]
(if (>= i end)
best
(let [m (pick! i end)]
(board/make! m)
(let [score (- (quiesce (- beta) (- alpha) (inc ply)))]
(board/unmake!)
(cond (stopped?) 0
(>= score beta) score
(> score best) (do (when (> score alpha) (new-pv! m ply))
(recur (inc i) (board/larger alpha score) score))
:else (recur (inc i) alpha best)))))))))))
;; The main search
(declare search)
(defn- child
"Search m's reply, m made: the first move with the full window; later ones with a null window,
reduced when late and quiet, and searched again at full depth and then with the full window
only if they beat alpha (principal variation search). A forced move, the side's only one, is
searched a ply deeper."
[depth alpha beta ply ^boolean pv? legal ^boolean quiet? ^boolean forced? ^boolean killer? h]
(let [new-depth (if forced? depth (dec depth))]
(if (== legal 1)
(- (search new-depth (- beta) (- alpha) (inc ply) pv?))
(let [r (if (and quiet? (>= depth 3))
(let [r (aget lmr (+ (* (board/smaller depth 63) 64) (board/smaller legal 63)))
r (if pv? (dec r) r)
r (if killer? (dec r) r)
r (- r (board/div h 5000))]
(board/larger 0 (board/smaller r (- depth 2))))
0)
score (- (search (- new-depth r) (- (inc alpha)) (- alpha) (inc ply) false))
score (if (and (> score alpha) (pos? r))
(- (search new-depth (- (inc alpha)) (- alpha) (inc ply) false))
score)]
(if (and pv? (> score alpha) (< score beta))
(- (search new-depth (- beta) (- alpha) (inc ply) true))
score)))))
(defn- root-move!
"At the root, remember the best move so far and its score: a search stopped part way through
an iteration may play it."
[ply m score]
(when (zero? ply)
(aset si root-move-slot m)
(aset si root-score-slot score)))
(defn- moves-loop
"Try the moves in order and return the best score, storing the result in the table. A side
with no move has lost."
[depth alpha beta ply ^boolean pv? tt-move]
(let [base (* ply max-moves)
end (board/generate! moves base false)
us (board/side)
k1 (aget killers (* ply 2))
k2 (aget killers (inc (* ply 2)))
forced? (== (- end base) 1)
original-alpha alpha]
(if (== end base)
(+ (- mate) ply) ; no move: lost
(do (score-moves! base end tt-move ply)
(loop [i base
alpha alpha
best (- infinity)
best-move 0
legal 0
n-tried 0] ; quiet moves searched, which the history's malus may lower
(if (>= i end)
(do (store! depth (if (> alpha original-alpha) exact upper) best best-move ply)
best)
(let [m (pick! i end)
quiet? (not (board/jump? m))
legal (inc legal)
h (if quiet? (aget history (history-index us m)) 0)]
(board/make! m)
(let [score (child depth alpha beta ply pv? legal quiet? forced? (or (== m k1) (== m k2)) h)]
(board/unmake!)
(when (and quiet? (< n-tried 64)) (aset quiets (+ (* ply 64) n-tried) m))
(cond (stopped?) 0
(>= score beta) (do (when quiet? (reward! m ply depth (board/smaller 64 (inc n-tried))))
(store! depth lower score m ply)
(root-move! ply m score)
score)
(> score alpha) (do (new-pv! m ply)
(root-move! ply m score)
(recur (inc i) score score m legal (if quiet? (inc n-tried) n-tried)))
:else (recur (inc i) alpha (board/larger best score) best-move legal
(if quiet? (inc n-tried) n-tried)))))))))))
(defn- search
"The score of the position on the board for the side to move, searched depth plies deep (plus
extensions, less reductions), within the window alpha to beta, at ply plies from the root. pv?
is true on the principal variation, which the table never cuts short."
[depth alpha beta ply ^boolean pv?]
(aset pv-length ply ply)
(cond
(stopped?) 0 ; the caller discards it
(and (pos? ply) (board/repetition?))
(draw-score ply)
;; forty moves each without a jump or a man moved, unless the side to move has no move: then
;; it has lost, as in the game
(and (pos? ply) (>= (aget board/state board/halfmove-slot) board/quiet-limit))
(if (board/has-move?) (draw-score ply) (+ (- mate) ply))
(>= ply (aget si ply-limit-slot)) (eval/evaluate) ; as deep as a line may go
:else
(let [alpha (if (pos? ply) (board/larger alpha (+ (- mate) ply)) alpha) ; nothing here beats winning now
beta (if (pos? ply) (board/smaller beta (- mate ply 1)) beta)]
(cond
(>= alpha beta) alpha
(<= depth 0) (quiesce alpha beta ply)
:else
(let [_ (count-node!)
tt (aget tables 0)
e (* 4 (bit-and (aget board/state board/hash-lo-slot) (aget si mask-slot)))
info (aget tt (+ e 3))
hit? (and (== (aget tt e) (aget board/state board/hash-hi-slot)) (not (zero? info)))
tt-score (from-table (bit-shift-right (bit-shift-left (aget tt (+ e 2)) 16) 16) ply)
tt-bound (bit-and (bit-shift-right info 8) 3)]
(if (and hit? (not pv?) (>= (dec (bit-and info 255)) depth)
(or (== tt-bound exact)
(and (== tt-bound lower) (>= tt-score beta))
(and (== tt-bound upper) (<= tt-score alpha))))
tt-score ; the table knows
(let [tt-move (if hit? (aget tt (+ e 1)) 0)]
;; internal iterative reduction: with no move from the table, search less deep
(moves-loop (if (and (>= depth 4) (zero? tt-move)) (dec depth) depth) alpha beta ply pv? tt-move))))))))
;; Iterative deepening
(defn- mate-in
"Moves to win for a winning score, negative when the side to move loses; else nil."
[score]
(cond (>= score mate-bound) (board/div (inc (- mate score)) 2)
(<= score (- mate-bound)) (- (board/div (- mate (- score)) 2))
:else nil))
(defn- line []
(mapv #(board/notation (aget pv %)) (range (aget pv-length 0))))
(defn think
"The computer's move for the position on the board, which is unchanged afterwards. Options:
:ms the time to aim for, in milliseconds (2,000)
:max-ms the time never to exceed (:ms): the search stops then, even part way through
an iteration
:depth the deepest iteration (64)
:ply-limit the deepest ply any line may reach, the jumps followed beyond the iteration's
depth included (95, the most the search's arrays hold)
:nodes the most nodes to search, for tests that must not depend on the clock
:contempt what a draw costs the side to move, in hundredths of a man (0)
:now the clock, in milliseconds
:on-iteration called with each completed iteration's report
Returns the report of the last completed iteration, or of the iteration under way if it had
already found a better move: :move as players write it, :score in hundredths of a man for the
side to move, :mate, the moves to a win, negative to a loss, :depth, :seldepth, :pv, :nodes,
:ms and :nps. With no move, :move is nil, and the side to move has lost."
[{:keys [ms max-ms depth ply-limit nodes contempt on-iteration now] :or {ms 2000 depth 64 contempt 0}}]
(let [now (or now #(.now js/performance))
limit (if ply-limit (board/larger 1 (board/smaller ply-limit (dec max-ply))) (dec max-ply))
depth (board/smaller depth limit)
start (now)
hard (+ start (or max-ms ms))
legal (board/legal-moves)]
(if (empty? legal)
{:move nil :score (- mate) :mate 0 :depth 0 :seldepth 0 :pv [] :nodes 0 :ms 0 :nps 0}
(do
(when-not (aget tables 0) (resize! 20))
(aset clock 0 now)
(aset sf nodes-slot 0)
(aset sf hard-slot hard)
(aset sf max-nodes-slot (or nodes js/Infinity))
(aset si stopped-slot 0)
(aset si contempt-slot contempt)
(aset si ply-limit-slot limit)
(aset si generation-slot (bit-and (inc (aget si generation-slot)) 1023))
(.fill killers 0)
(dotimes [i 256] (aset history i (board/div (aget history i) 2)))
(loop [d 1
done nil
stable 0]
(aset si seldepth-slot 0)
(aset si root-move-slot 0)
(let [prev (:score done 0)
score (loop [delta 25
alpha (if (>= d 5) (board/larger (- infinity) (- prev delta)) (- infinity))
beta (if (>= d 5) (board/smaller infinity (+ prev delta)) infinity)]
(let [s (search d alpha beta 0 true)]
(cond (stopped?) s
(<= s alpha) (recur (* 2 delta) (board/larger (- infinity) (- s (* 2 delta))) (board/div (+ alpha beta) 2))
(>= s beta) (recur (* 2 delta) alpha (board/smaller infinity (+ s (* 2 delta))))
:else s)))
elapsed (- (now) start)
n (aget sf nodes-slot)
partial? (stopped?)
report (fn [move score]
{:move (board/notation move)
:score (bit-or score 0) ; never -0, a level position's negated
:mate (mate-in score)
:depth (if partial? (dec d) d)
:seldepth (aget si seldepth-slot)
;; the root's variation, when it is move's; a stopped iteration may have
;; found move without writing its line
:pv (if (and (pos? (aget pv-length 0)) (== (aget pv 0) move)) (line) [(board/notation move)])
:nodes n
:ms (js/Math.round elapsed)
:nps (if (pos? elapsed) (js/Math.round (/ (* 1000 n) elapsed)) 0)})]
(if partial?
;; stopped: the iteration under way counts only if it found a new best move
(let [m (aget si root-move-slot)]
(cond (and (nil? done) (zero? m)) (report (first legal) 0)
(and (not (zero? m)) (or (nil? done) (not (= (board/notation m) (:move done))))) (report m (aget si root-score-slot))
:else (assoc done :nodes n :ms (js/Math.round elapsed))))
(let [r (report (aget pv 0) score)
stable (if (= (:move r) (:move done)) (inc stable) 0)]
(when on-iteration (on-iteration r))
(if (or (== 1 (count legal))
(>= d depth)
(and (mate-in score) (>= d (+ 2 (* 2 (js/Math.abs (mate-in score))))))
;; time: the next iteration takes longer than this one; stop early when the move is settled
(> elapsed (* ms (cond (>= stable 4) 0.3 (zero? stable) 0.7 :else 0.5))))
r
(recur (inc d) r stable))))))))))checkers.game · 452 lines
(ns checkers.game
"A game of Checkers as data: its moves, its result, and how it is stored, as chessmate.game keeps
Chessmate's. The rules are the board's (checkers.board): each function that asks about a
position sets the board to it. The game's effects are checkers.core's.
A game is a map:
:start-fen where it began, in FEN
:fens the FEN of every position so far, the start first and the current last
:moves its moves as players write them, such as \"11-15\" or \"22x15x6\"
:players who moves for each side, :human or :computer, as {:black :human :white :computer}
:think-ms the computer's thinking time for each side, in ms; and :max-depth the depth its
search's iterations may reach, the page's Depth, nil for no limit. Each is a map
by side, {:black … :white …}
:flipped? whether the board is turned round from the visitor's side
:paused? whether the game is paused: nothing thinks until it goes on
:result nil while it goes on; then its :reason and, unless a draw, its :winner
:later the moves taken back, while there are any: the line the game had gone on to,
which the move list shows after its moves, to play again, until another move is
played
:previous the game before this one, which Take Back goes back to from a new game"
(:require
[checkers.board :as board]
[clojure.string :as str]))
(def sides "The sides, in the order they move." [:black :white])
(defn other [side] (if (= side :black) :white :black))
(def default-think-ms
"A new game's thinking time, the Difficulty's Easy level's (owner, 2026-09-29: \"Checkers should
default to Easy\")."
250)
(def default-max-depth "And its depth, Easy's too." 4)
(defn playing
"The players when the visitor plays side against the computer."
[side]
{side :human (other side) :computer})
(defn- side-of-code "A side, :black or :white, from the board's 0 or 1." [s] (if (zero? s) :black :white))
;; How a game ends
(defn- reversible?
"Could the move from position a to position b, both FENs, be undone: a king's step, which takes
nothing and leaves every man where it was?"
[a b]
(let [men (fn [fen] (let [pieces (:pieces (board/read-fen fen))]
[(count pieces) (into {} (filter (fn [[_ p]] (== board/man (board/kind p)))) pieces)]))]
(= (men a) (men b))))
(defn quiet-plies
"How many moves, counting each side's, the game with these positions has made since its last
jump or man's move."
[fens]
(loop [i (dec (count fens))
n 0]
(if (and (pos? i) (reversible? (nth fens (dec i)) (nth fens i)))
(recur (dec i) (inc n))
n)))
(defn since-irreversible
"The game's position after its last jump or man's move, as a FEN, and its moves since: all the
search needs to know which positions have occurred, and how long the forty moves have run, and
no more."
[fens moves]
(let [i (- (dec (count fens)) (quiet-plies fens))]
[(nth fens i) (subvec (vec moves) i)]))
(defn ending
"How a game with these positions (FENs, the current last) has ended, or nil if it goes on: the
side to move with no move has lost, its pieces all taken or all blocked; a position occurring
for the third time, or forty moves each with no jump and no man moved, is a draw."
[fens]
(let [fen (peek fens)]
(board/set-position! fen)
(let [to-move (side-of-code (board/side))
pieces (+ (aget board/counts (* 2 (board/side))) (aget board/counts (inc (* 2 (board/side)))))]
(cond (not (board/has-move?)) {:winner (other to-move) :reason (if (zero? pieces) :no-pieces :blocked)}
(<= 3 (count (filter #{fen} fens))) {:reason :repetition}
(>= (quiet-plies fens) board/quiet-limit) {:reason :forty-moves}
:else nil))))
;; Settings kept for each side
(defn- per-side
"A setting for each side, from v: a map by side, or one value for both, or nil for dflt."
[v dflt]
(let [one #(if (some? %) % dflt)]
(if (map? v)
{:black (one (:black v)) :white (one (:white v))}
{:black (one v) :white (one v)})))
(defn setting "Side's value of a setting kept for each side, such as :think-ms." [game k side] (get-in game [k side]))
;; A new game, and the game as it stands
(defn new-game
"A game from a FEN, the standard start by default. A FEN that is not a position a game can reach
throws with the reason. The players are the visitor as Black, White moving first, against the
computer, unless players, or human, the visitor's side, says otherwise; the computer thinks for
think-ms a move, to max-depth, nil for no limit, each a map by side or one value for both, at the
Easy level unless they are given; and a game the computer plays against itself waits to be
started, paused."
([] (new-game {}))
([{:keys [start-fen players human think-ms max-depth flipped?] :as options}]
(board/set-position! (or start-fen board/standard-start))
(let [fen (board/fen)
players (or players (playing (or human :black)))]
{:start-fen fen
:fens [fen]
:moves []
:players players
:think-ms (per-side think-ms default-think-ms)
:max-depth (if (contains? options :max-depth) (per-side max-depth nil) (per-side default-max-depth nil))
:flipped? (boolean flipped?)
:paused? (not-any? #{:human} (vals players))
:result (ending [fen])})))
(defn fen [game] (peek (:fens game)))
(defn to-move "The side to move: :black or :white." [game] (if (str/starts-with? (fen game) "W") :white :black))
(defn player "Who moves for side: :human or :computer." [game side] (get-in game [:players side] :computer))
(defn humans-turn? [game] (= :human (player game (to-move game))))
(defn human-side
"The side the visitor plays against the computer, or nil when both sides are human or neither
is: the side the page calls \"you\"."
[game]
(let [humans (filter #(= :human (player game %)) sides)]
(when (= 1 (count humans)) (first humans))))
(defn bottom
"The side at the foot of the board: the visitor's, or White's, as players draw the board, when
two play or the computer plays itself; unless the board is turned round."
[game]
(let [base (or (human-side game) :white)]
(if (:flipped? game) (other base) base)))
(defn waiting?
"Whether the game is new and paused: it waits to be started."
[game]
(boolean (and (:paused? game) (empty? (:moves game)) (nil? (:result game)))))
(defn arrive
"The game as the page shows it on arriving: paused, so that nothing plays until the visitor
says so, unless it is over."
[game]
(if (:result game) game (assoc game :paused? true)))
(def ^:private engine-settings "How the computer plays a side, kept for each side." [:think-ms :max-depth])
(defn- lone-computer
"The side the computer plays when it plays one side only, or nil."
[players]
(let [computers (filter #(= :computer (get players %)) sides)]
(when (= 1 (count computers)) (first computers))))
(defn with-players
"The game, or a new game's settings, with players moving for its sides: when the computer, which
played one side, now plays the other, its settings go with it (owner, 2026-09-28, through the
Chessmate settings' rework: switching Play As between White and Black keeps the computer's
settings). Where it plays both sides, or neither, each side keeps its own."
[game players]
(let [from (lone-computer (:players game))
to (lone-computer players)]
(cond-> (assoc game :players players)
(and from to (not= from to))
(as-> g (reduce (fn [g k]
(let [v (get g k)]
(if (map? v) (assoc-in g [k to] (get v from)) g)))
g
engine-settings)))))
(defn set-players
"The game with players moving for its sides from now on, {:black :human :white :computer}, the
computer's settings going with it to its new side (with-players). A game the computer is to play
against itself pauses, and waits for Play; any other goes on as it was, paused or not."
[game players]
(cond-> (with-players game players)
(and (not-any? #{:human} (vals players)) (not (:paused? game)) (nil? (:result game)))
(assoc :paused? true)))
(defn legal-moves
"The side to move's moves, as the board makes them, with the board set to the game's position."
[game]
(board/set-position! (fen game))
(board/legal-moves))
(defn threats
"The squares of the side to move's pieces that the other side could jump, were it its move,
numbered from 1: what Show Threats marks."
[game]
(board/set-position! (fen game))
(mapv inc (board/threatened)))
;; Playing, and taking back
(defn- with-later
"The game with later as the moves it has taken back, or with none."
[game later]
(if (seq later) (assoc game :later (vec later)) (dissoc game :later)))
(defn play
"The game after move m, which must be one of legal-moves' for its position: the move recorded as
players write it, the new position, and the result if the game has ended. The next of the moves
taken back, played again, leaves the rest of them to play; any other move leaves their line,
and they are forgotten."
[game m]
(board/set-position! (fen game))
(let [text (board/notation m)
later (:later game)
_ (board/make! m)
fens (conj (:fens game) (board/fen))]
(-> game
(assoc :fens fens
:moves (conj (:moves game) text)
:result (ending fens))
(with-later (when (= text (first later)) (subvec later 1))))))
(defn play-text
"The game after the move written as text, which must be legal in its position; else nil."
[game text]
(board/set-position! (fen game))
(when-let [m (first (board/parse-move text))]
(play game m)))
(defn resign
"The game, lost by side's resignation."
[game side]
(assoc game :result {:winner (other side) :reason :resignation}))
(def ^:private settings
"What the visitor sets for a game, which Take Back keeps as it is: who plays each side, how the
computer plays it, and which way the board faces."
[:players :think-ms :max-depth :flipped?])
(defn- white-first? [game] (str/starts-with? (:start-fen game) "W"))
(defn- mover
"The side that made move i of the game, from 0."
[game i]
(if (= (white-first? game) (even? i)) :white :black))
(defn take-back
"The game with its last move taken back, and the moves taken back, newest first (as Chessmate's
Take Back, chessmate.game/take-back): when a person plays, the computer's moves since that
person's last are taken back with it, so that it is their move again; two people take back one
move; and the computer playing itself its last move. A game with no move, as a reset board is,
gives way to the game before it, with :previous-game for the moves, in the settings as they are
now. Take Back never changes a setting. A game that the computer is then to move in is paused,
so that it waits for Play rather than moving again at once. The moves taken back are kept, in
:later, for the move list to play again."
[game]
(let [played (count (:moves game))
last-human (last (filter #(= :human (player game (mover game %))) (range played)))
n (cond last-human (- played last-human) (pos? played) 1 :else 0)
before (:previous game)
waits #(cond-> % (and (nil? (:result %)) (not (humans-turn? %))) (assoc :paused? true))]
(cond (pos? n) (let [keep (- played n)]
[(waits (-> game
(assoc :fens (subvec (:fens game) 0 (inc keep))
:moves (subvec (:moves game) 0 keep)
:result nil)
(with-later (into (subvec (:moves game) keep) (:later game)))))
(vec (reverse (take-last n (:moves game))))])
before [(waits (merge before (select-keys game settings))) :previous-game]
:else [game []])))
(defn can-take-back?
"Whether Take Back has something to take back: a move, or, with none, the game before."
[game]
(boolean (or (seq (:moves game)) (:previous game))))
(defn go-to
"The game as it was after its first ply moves, 0 being its start: back to one of its moves, the
moves after it taken back and kept in :later; or on to one of the moves taken back, those up to
it played again. It then waits, paused, for Play or a person's move, unless it is over. No
setting changes. nil when it has no such move."
[game ply]
(let [played (count (:moves game))
later (:later game)]
(cond (or (not (integer? ply)) (not (<= 0 ply (+ played (count later))))) nil
(= ply played) game
:else (let [g (if (< ply played)
(-> game
(assoc :fens (subvec (:fens game) 0 (inc ply))
:moves (subvec (:moves game) 0 ply)
:result nil)
(with-later (into (subvec (:moves game) ply) later)))
(reduce (fn [g text] (or (play-text g text) (reduced g)))
game
(subvec later 0 (- ply played))))]
(assoc g :paused? (nil? (:result g)))))))
(defn ply-after
"How many moves the game has made once side, :white or :black, has made its move numbered n,
as the game numbers them: 1 after White's first, 2 after Black's, when White moves first."
[game n side]
(+ (* 2 (dec n)) (if (= side :white) 1 2) (if (white-first? game) 0 -1)))
(defn rows
"The game's moves, texts, as numbered rows, [number white black], as the move list shows them,
White's first as it moves first: a game set up with Black to move starts its first row with no
White move."
[game texts]
(let [texts (cond->> texts (not (white-first? game)) (cons nil))]
(map-indexed (fn [i [w b]] [(inc i) w b]) (partition-all 2 texts))))
(defn move-text
"The last move with its number, as \"1. 23-19\" or \"1... 11-15\", and the result if it ended the
game."
[game]
(let [ply (dec (count (:moves game)))
white? (= :white (mover game ply))
number (inc (quot (+ ply (if (white-first? game) 0 1)) 2))]
(str number (if white? ". " "... ") (peek (:moves game))
(when-let [{:keys [winner]} (:result game)]
(str " " (case winner :black "Black wins" :white "White wins" "drawn"))))))
;; The game as PDN, for the move list's Copy and (checkers/pdn)
(defn today
"Today's date as PDN writes it, as \"2026.09.28\"."
[]
(let [d (js/Date.)
pad #(.padStart (str %) 2 "0")]
(str (.getFullYear d) "." (pad (inc (.getMonth d))) "." (pad (.getDate d)))))
(defn- pdn-result
"A game's result as PDN gives English draughts', Black's score first, as its first player's: 1-0
when Black wins, 0-1 when White does, 1/2-1/2 for a draw, and * while the game goes on."
[result]
(cond (nil? result) "*"
(= :black (:winner result)) "1-0"
(= :white (:winner result)) "0-1"
:else "1/2-1/2"))
(defn pdn
"The game as Portable Draughts Notation, on date, such as \"2026.09.28\": its tags, a person
named Visitor and the computer Computer, English draughts' game type, 21, and the position it
began from, which a reader must be told unless it is English draughts' own start, with Black to
move; then its moves, numbered, as rows of at most 79 characters, and its result."
[game date]
(let [result (pdn-result (:result game))
tag (fn [k v] (str "[" k " \"" v "\"]"))
named #(if (= :human (player game %)) "Visitor" "Computer")
tags (cond-> [(tag "Event" "Casual game") (tag "Site" "https://petrustheron.com/checkers") (tag "Date" date)
(tag "Black" (named :black)) (tag "White" (named :white)) (tag "Result" result) (tag "GameType" "21")]
(not= (:start-fen game) board/english-start) (conj (tag "FEN" (:start-fen game))))
words (concat (mapcat (fn [[n w b]] (cond-> [(str n (if w "." "..."))] w (conj w) b (conj b)))
(rows game (:moves game)))
[result])
lines (reduce (fn [lines w]
(let [l (peek lines)]
(if (and l (<= (+ (count l) 1 (count w)) 79)) (conj (pop lines) (str l " " w)) (conj lines w))))
[]
words)]
(str/join "\n" (concat tags [""] lines))))
;; Storage: JSON of the game's data only, validated by replaying it, and never evaluated
(defn- side-data [game k] {"black" (setting game k :black) "white" (setting game k :white)})
(defn- data
"The game as plain data for storage: where it began, its moves, who plays each side, how the
computer plays them, the board's way round, whether it is paused, a resignation, which the moves
cannot show, and the moves taken back."
[game]
(cond-> {"v" 1
"startFen" (:start-fen game)
"moves" (:moves game)
"players" {"black" (name (player game :black)) "white" (name (player game :white))}
"think" (side-data game :think-ms)
"maxDepth" (side-data game :max-depth)
"flipped" (:flipped? game)}
(:paused? game) (assoc "paused" true)
(= :resignation (:reason (:result game))) (assoc "resigned" (name (other (:winner (:result game)))))
(seq (:later game)) (assoc "later" (:later game))))
(defn encode
"The game as JSON for browser storage, with the game before it, for Take Back."
[game]
(js/JSON.stringify (clj->js (cond-> (data game)
(:previous game) (assoc "previous" (data (:previous game)))))))
(defn- stored-sides
"A setting kept for each side in stored data, v, {\"black\" … \"white\" …}, each value valid by
ok?: [value], or nil if it is not valid."
[v ok?]
(when (object? v)
(let [b (unchecked-get v "black")
w (unchecked-get v "white")]
(when (and (ok? b) (ok? w)) [{:black b :white w}]))))
(defn- from-data
"The game stored data holds, or nil if it does not hold one: if a field is missing or out of
range, or if the FEN or any move is not legal. A finished game is one only if finished? says so,
as the game before may be. The moves taken back come with it while they are legal."
[^js data finished?]
(let [kind {"human" :human "computer" :computer}
ps (unchecked-get data "players")
players (when (object? ps)
(let [b (kind (unchecked-get ps "black"))
w (kind (unchecked-get ps "white"))]
(when (and b w) {:black b :white w})))
[think :as think?] (stored-sides (unchecked-get data "think") #(and (integer? %) (<= 10 % 300000)))
[max-depth :as max-depth?] (stored-sides (unchecked-get data "maxDepth") #(or (nil? %) (and (integer? %) (<= 1 % 64))))
flipped (unchecked-get data "flipped")
paused (unchecked-get data "paused")
resigned ({"black" :black "white" :white} (unchecked-get data "resigned"))
moves (unchecked-get data "moves")
later (unchecked-get data "later")]
(when (and (object? data)
(== 1 (unchecked-get data "v"))
(string? (unchecked-get data "startFen"))
players think? max-depth?
(boolean? flipped)
(or (nil? paused) (boolean? paused))
(array? moves))
(let [start (try (new-game {:start-fen (unchecked-get data "startFen") :players players :think-ms think
:max-depth max-depth :flipped? flipped})
(catch :default _ nil))
game (when start
(reduce (fn [g text] (or (when (and (string? text) (nil? (:result g))) (play-text g text)) (reduced nil)))
start
moves))
game (cond-> game (and game resigned (nil? (:result game))) (resign resigned))]
(when (and game (or finished? (nil? (:result game))))
(let [g (assoc game :paused? (boolean paused))
;; the moves taken back, while they are legal from here; a bad one loses them, not the game
played (when (array? later)
(reduce (fn [g text] (or (when (and (string? text) (nil? (:result g))) (play-text g text)) (reduced nil)))
(dissoc g :result)
later))]
(with-later g (when played (subvec (:moves played) (count (:moves g)))))))))))
(defn decode
"The unfinished game that encode wrote as text, with the game before it, or nil if text is not
one: if it is not JSON, if a field is missing or out of range, if the FEN or any move is not
legal, or if the game has ended. It is read as data, and each move is replayed by the rules."
[text]
(try
(let [^js d (js/JSON.parse text)]
(when-let [game (from-data d false)]
(if-let [before (some-> (unchecked-get d "previous") (from-data true))]
(assoc game :previous before)
game)))
(catch :default _ nil)))checkers.worker · 88 lines
(ns checkers.worker
"Checkers' background search: what its compiled worker does with each message, as Chessmate
2026's does (chessmate.v2.worker). Evaluating this namespace only defines functions;
checkers.worker-main starts it. The worker lives on between the computer's moves, so its
transposition table and move history carry what it learnt thinking about one move into the
next."
(:require
[checkers.board :as board]
[checkers.eval :as eval]
[checkers.search :as search]))
(defn request
"A message for the worker: its type, \"search\", or \"perft\" or \"evaluate\" for the tests; its
id; the position, as a FEN and the moves played from it, as players write them; and more
fields from extra, a map with string keys."
[type id fen moves extra]
(let [msg #js {"type" type
"id" id
"fen" fen
"moves" (to-array moves)}]
(doseq [[k v] extra] (unchecked-set msg k v))
msg))
(defn- play!
"Play a legal move, written as players write it, or throw if it is not one."
[text]
(if-let [m (first (board/parse-move text))]
(board/make! m)
(throw (js/Error. (str "not a legal move here: " text)))))
(defn set-position!
"Set the board to a request's position: its FEN, then its moves, so that the board knows the
positions they passed through, for repetitions, and the moves since the last jump or man's
move, for the forty-move rule."
[^js msg]
(board/set-position! (unchecked-get msg "fen"))
(doseq [m (unchecked-get msg "moves")] (play! m)))
(defn- reply
"An info or best message from a search report: the score for the side to move, in hundredths
of a man, and the line."
[type id {:keys [move score mate depth seldepth pv nodes nps ms]}]
#js {"type" type
"id" id
"move" move
"score" score
"mate" mate
"depth" depth
"reached" seldepth
"pv" (to-array pv)
"nodes" nodes
"nps" nps
"ms" ms})
(defn handle
"Answer one message from the page, passing each reply to post. Messages and replies are plain
JavaScript objects with string keys, so the compiled worker never loses a field to renaming."
[^js msg post]
(let [kind (unchecked-get msg "type")
id (unchecked-get msg "id")]
(try
(case kind
"ping" (post #js {"type" "pong" "id" id})
"search" (do (post #js {"type" "started" "id" id}) ; at once: the page waits 5 s for this, not for a result
(set-position! msg)
(post (reply "best" id (search/think {:ms (or (unchecked-get msg "ms") 2000)
:max-ms (unchecked-get msg "maxMs")
:depth (or (unchecked-get msg "depth") 64)
:ply-limit (unchecked-get msg "plyLimit")
:nodes (unchecked-get msg "nodes")
:contempt (or (unchecked-get msg "contempt") 0)
:on-iteration #(post (reply "info" id %))}))))
"evaluate" (do (set-position! msg)
(post #js {"type" "evaluate" "id" id "score" (eval/evaluate)}))
"perft" (let [_ (set-position! msg)
start (.now js/performance)
nodes (board/perft (unchecked-get msg "depth"))]
(post #js {"type" "perft" "id" id "nodes" nodes "ms" (- (.now js/performance) start)}))
"clear" (do (search/clear!) (post #js {"type" "cleared" "id" id}))
(post #js {"type" "error" "id" id "message" (str "unknown message type " (pr-str kind))}))
(catch :default e
(post #js {"type" "error" "id" id "message" (ex-message e)})))))
(defn start!
"Answer the page's messages. Only the compiled worker calls this, from checkers.worker-main."
[]
(set! (.-onmessage js/self)
(fn [^js e] (handle (.-data e) (fn [reply] (.postMessage js/self reply))))))checkers.core · 738 lines
(ns checkers.core
"Play Checkers on /checkers: the game, and the commands the Listener reaches as checkers/....
The game is the one checkers.game describes, and the computer plays it with Chessmate 2026's
search, on the Checkers board (checkers.search), in a background worker, as Chessmate plays on
/chessmate (chessmate.v2.core).
Every move, the visitor's and the computer's, is a (checkers/move! !game ...) form evaluated
through the Listener, so the transcript is the whole game."
(:require
[checkers.board :as board]
[checkers.eval :as eval]
[checkers.game :as game]
[checkers.search :as search]
[checkers.worker :as worker]
[clojure.string :as str]
[pt.host :as host]))
(defonce ^{:doc "The game on the page, as checkers.game makes it: the REPL's !game, which @!game shows, and
which every command that changes the game takes first."}
!game (atom nil))
(defonce ^:private !engine (atom {:status :idle})) ; what the computer is doing, for the players' bars and (checkers/game)
(defonce ^:private !search-id (atom 0)) ; each search's number: a reply to an older one is stale
(defonce ^:private !replying (atom false)) ; true while the computer's own move is evaluated
(defonce ^:private !mounted (atom false)) ; true while /checkers shows the game: only then does the computer think
(def ^:private storage-key
"Where the game is kept in this browser. The keys before it are left behind, and removed:
\"pt87.checkers\" kept the games from before White moved first, and \"pt87.checkers2\" those from
before the Easy level was the default (owner, 2026-09-29), which would come back as they were."
"pt87.checkers3")
(def thinking-times
"The thinking times the settings offer, in ms: 10 ms to 5 minutes, as Chessmate's."
[10 20 25 50 100 250 500 1000 1500 2000 3000 5000 10000 20000 30000 60000 120000 180000 300000])
(def ^:private contempt
"What a draw costs the computer, in hundredths of a man: enough to play on in a level position,
rather than repeat moves."
10)
(def ^:private fallback-slice-ms 40) ; when the worker cannot run: the page searches this long per task
(def ^:private fallback-ms 1000) ; for this long in all
(def ^:private glyphs "The pieces as characters, for (checkers/board): Black's men and kings, and White's." {0 "·" 1 "b" 2 "B" 9 "w" 10 "W"})
(defn- side-name [side] (str/capitalize (name side)))
(defn- think-time [g side] (or (game/setting g :think-ms side) game/default-think-ms))
(def difficulties
"The page's Difficulty, as Chessmate's (owner, 2026-09-28): each level's Depth and Thinking
Time, as the game keeps them, :max-depth, nil for no limit, and :think-ms. \"Difficulty modes
should also set Thinking Time: Novice: 10ms ... Easy: 250ms ... Medium: 500ms. Hard: 5s.
Chessmate: Unlimited (unless constrained by Game Mode)\", and with no clock, as Checkers has
none, \"Make it 30s.\""
(array-map :novice {:max-depth 2 :think-ms 10}
:easy {:max-depth 4 :think-ms 250}
:medium {:max-depth 6 :think-ms 500}
:hard {:max-depth 8 :think-ms 5000}
:chessmate {:max-depth nil :think-ms 30000}))
(defn- difficulty-of
"The Difficulty that side's Depth and Thinking Time make in game g, or nil when they make none."
[g side]
(some (fn [[level settings]] (when (every? (fn [[k v]] (= v (game/setting g k side))) settings) level)) difficulties))
(defn- set-board!
"Put the game's position on the board, after the moves since the last jump or man's move, so that
repetitions and the forty moves count."
[g]
(let [[fen texts] (game/since-irreversible (:fens g) (:moves g))]
(board/set-position! fen)
(doseq [t texts] (board/make! (first (board/parse-move t))))))
(defonce ^:private !verdict (atom [nil 0])) ; the last position evaluated, by FEN, and its score
(defn- white-score
"The evaluation of the game's position from White's point of view, in men: the evaluation alone
needs no history. The page redraws while the computer thinks, so the last one is kept."
[g]
(let [fen (game/fen g)
[seen score] @!verdict]
(if (= fen seen)
score
(let [_ (board/set-position! fen)
s (eval/evaluate)
score (/ (if (== (board/side) board/white) s (- 0 s)) 100)]
(reset! !verdict [fen score])
score))))
(def ^:private level-margin "How far ahead, in men, a side must be for the verdict to name it." 0.2)
(defn- winning [score] (cond (> score level-margin) :white (< score (- level-margin)) :black :else :neither))
(defn- computers-turn? [g] (and g (nil? (:result g)) (not (game/humans-turn? g))))
(defn- search-state
"A search's report, as the page and (checkers/game) show it: the score in men from White's point
of view, and a win found for either side."
[g {:keys [depth reached score mate pv nodes nps ms]}]
(let [white? (= :white (game/to-move g))
white-score (/ (if white? score (- 0 score)) 100)]
{:depth depth
:reached (max (or reached 0) (or depth 0))
:men white-score
:mate (when mate (if (= (pos? mate) white?) (js/Math.abs mate) (- (js/Math.abs mate)))) ; White's win, or Black's, negative
:score (if mate
(str (if (= (pos? mate) white?) "White" "Black") " wins in " (js/Math.abs mate))
(str (when-not (neg? white-score) "+") (.toFixed white-score 2)))
:ahead (if mate (if (= (pos? mate) white?) :white :black) (winning white-score))
:pv (vec pv)
:nodes nodes
:nps nps
:ms ms}))
;; What the page shows
(defn- result-text
"How game g ended, in words: to the visitor when one side is theirs, and else by colour."
[{:keys [reason winner]} g]
(let [you (game/human-side g)
wins #(cond (nil? you) (str (side-name winner) " wins") (= winner you) "You win" :else "The computer wins")
loser (when winner (game/other winner))
who #(cond (nil? you) (side-name %) (= % you) "you" :else "the computer")]
(case reason
:no-pieces (str (wins) ": " (who loser) " " (if (= loser you) "have" "has") " no pieces left")
:blocked (str (wins) ": " (who loser) " cannot move")
:resignation (str (wins) ": " (who loser) " resigned")
:repetition "Drawn by threefold repetition"
:forty-moves "Drawn: forty moves each without a jump or a man moved")))
(defn- status-text [g {:keys [status]}]
(let [itself? (not-any? #(= :human (game/player g %)) game/sides)
for-side (when itself? (str " for " (side-name (game/to-move g))))]
(cond (:result g) (str/replace (result-text (:result g) g) #"^[a-z]" str/upper-case)
(and (game/waiting? g) (computers-turn? g)) "Waiting to start"
(game/waiting? g) (if (game/human-side g) "Your move" (str (side-name (game/to-move g)) " to move"))
(and (:paused? g) (computers-turn? g)) "Paused"
(:paused? g) (str "Paused: " (if (game/human-side g) "your move" (str (side-name (game/to-move g)) " to move")))
(#{:thinking :fallback} status) (str "The computer is thinking" for-side (when (= status :fallback) ", at reduced strength"))
(computers-turn? g) (str "The computer is to move" for-side)
:else (if (game/human-side g) "Your move" (str (side-name (game/to-move g)) " to move")))))
(defn- signed [x] (let [r (/ (js/Math.round (* x 100)) 100)] (str (when (>= r 0) "+") (.toFixed r 2))))
(defn- verdict
"Who is winning, in words: the result once the game is over, a win when the search finds one, or
else the side ahead and the score."
[g ahead score]
(cond (:result g) (case (:winner (:result g)) :white "White won" :black "Black won" "Drawn")
(str/includes? score "wins") score
:else (str (case ahead :white "White is winning" :black "Black is winning" "Level") ", " score)))
(defn- stats
"Who is winning, by the last search while its score is this position's, or else by the
evaluation: in words, and as White's score in men, and a win found, White's positive and Black's
negative, for the board's bar; and that search's depth, nodes, speed and time."
[g {:keys [depth reached score ahead nodes nps ms men mate]}]
(let [[ahead score men] (if depth [ahead score men] (let [w (white-score g)] [(winning w) (signed w) w]))]
(cond-> {:verdict (verdict g ahead score) :men men}
(and depth mate) (assoc :mate mate)
depth (assoc :depth depth :seldepth reached :nodes nodes :nps nps :ms ms))))
(defn- ui-code
"A piece as the board draws it: White's positive, Black's negative, 1 for a man and 2 for a king."
[piece]
(if (zero? piece) 0 (* (if (== (board/side-of piece) board/white) 1 -1) (board/kind piece))))
(defn- legal-targets
"The visitor's moves, by the square each starts from: each move's squares, where it lands and
what it takes, numbered from 1, and the form that plays it. None on the computer's turn, and
none once the game is over."
[g]
(if (or (:result g) (not (game/humans-turn? g)))
{}
(reduce (fn [targets m]
(update targets (str (inc (board/move-from m))) (fnil conj [])
{:path (mapv inc (rest (board/landings m)))
:taken (mapv inc (board/taken m))
:crowns (board/crowns? m)}))
{}
(game/legal-moves g))))
(defn- refused-targets
"The visitor's steps that a jump they must make forbids, by the square each starts from, so that
the board can say why: none unless they must jump."
[g]
(if (or (:result g) (not (game/humans-turn? g)))
{}
(let [moves (game/legal-moves g)]
(if (and (seq moves) (board/jump? (first moves)))
(reduce (fn [targets m] (update targets (str (inc (board/move-from m))) (fnil conj []) (inc (board/move-to m))))
{}
(board/steps))
{}))))
(defn- last-move
"The game's last move's squares: where it started and each square it landed on, and the pieces
it took, numbered from 1; or nil before the first move."
[g]
(when-let [text (peek (:moves g))]
(board/set-position! (peek (pop (:fens g))))
(when-let [m (first (board/parse-move text))]
{:path (mapv inc (board/landings m)) :taken (mapv inc (board/taken m))})))
(defonce ^:private !pdn (atom [nil nil])) ; the last game written as PDN, by what PDN says of it, and its PDN
(defn- pdn-text
"Game g as PDN, for the move list's Copy: written again only when its start, moves, result or
players change, as the page redraws while the computer thinks."
[g]
(let [k [(:start-fen g) (:moves g) (:result g) (:players g)]
[seen text] @!pdn]
(if (= k seen)
text
(let [text (game/pdn g (game/today))]
(reset! !pdn [k text])
text))))
(defn- draw-now! []
(let [g @!game
e @!engine
last (last-move g)
_ (board/set-position! (game/fen g))
squares (mapv #(ui-code (aget board/squares %)) (range 32))]
(.draw (host/checkers-host)
(clj->js {:squares squares
:bottom (name (game/bottom g))
:flipped (boolean (:flipped? g)) ; turned round from the visitor's side, or from White's with no one visitor
:human (some-> (game/human-side g) name)
:players {:black (name (game/player g :black)) :white (name (game/player g :white))}
:turn (name (game/to-move g))
:last (:path last)
:taken (:taken last)
:legal (legal-targets g)
:refused (refused-targets g)
:thinking (contains? #{:thinking :fallback} (:status e))
:engine (name (:status e))
:since (:since e)
:status (status-text g e)
:over (some? (:result g))
:result (when-let [{:keys [reason winner]} (:result g)] {:reason (name reason) :winner (some-> winner name)})
:take-back (game/can-take-back? g)
:think-ms {:black (think-time g :black) :white (think-time g :white)}
:max-depth {:black (game/setting g :max-depth :black) :white (game/setting g :max-depth :white)}
:paused (boolean (:paused? g))
:start (game/waiting? g)
:pv (when (#{:thinking :fallback} (:status e)) (:pv e))
:threats (when (nil? (:result g)) (game/threats g))
:stats (stats g e)
:rows (game/rows g (:moves g))
:line (game/rows g (into (:moves g) (:later g)))
:go-to true
;; the Difficulty the computer plays the visitor at, for the settings' radio buttons
:difficulty (some->> (game/human-side g) game/other (difficulty-of g) name)
:pdn (pdn-text g)}))))
(defn- draw!
"Show the game on /checkers: the board, the players, the controls and the moves."
[]
(when @!mounted (draw-now!)))
(defn- announce! [text] (when @!mounted (.announce (host/checkers-host) text)))
;; Storage: the game as data, validated when read, and never evaluated
(defn- save! []
(try
(if (:result @!game)
(.removeItem js/localStorage storage-key)
(.setItem js/localStorage storage-key (game/encode @!game)))
(catch :default _ nil)))
(defn- restore [] (try (game/decode (.getItem js/localStorage storage-key)) (catch :default _ nil)))
;; The computer's replies: each a (checkers/move! !game ...) form, built by code from a legal move
(defn- move-form [text] (str "(checkers/move! !game " (str/join " " (str/split text #"[-x]")) ")"))
(defn- reply!
"Play the computer's move, as players write it, found by search id at ply, unless the game has
moved on."
[id ply text tag]
(let [g @!game]
(when (and (= id @!search-id) (= ply (count (:moves g))) (computers-turn? g) (string? text)
(do (board/set-position! (game/fen g)) (seq (board/parse-move text))))
(reset! !replying true)
(try (host/run! (move-form text) {:origin "machine" :tag tag})
(finally (reset! !replying false))))))
(defn- search-tag [{:keys [depth reached score nodes ms]}]
(str "checkers · depth " depth " · sel " reached " · " score " · " (.toLocaleString nodes "en") " nodes · "
(.toFixed (/ ms 1000) 1) " s"))
(defn- finish-search!
"Show a search's result, and play its move."
[id ply g {:keys [move] :as report}]
(let [shown (search-state g report)]
(swap! !engine merge shown)
(reply! id ply move (search-tag shown))))
(defn- fallback!
"Search on the page, when the worker cannot run: the same search in this machine's interpreter,
fallback-slice-ms per task so that the page never freezes, for fallback-ms in all. Each slice
deepens what the last one learnt, which the transposition table keeps."
[id ply g]
(let [start (.now js/performance)]
(swap! !engine assoc :status :fallback)
(draw!)
(when-not (search/table?) (search/resize! 16)) ; 1 MB: the page is no place for the worker's 16
((fn next-slice [best nodes]
(when (= id @!search-id)
(set-board! g) ; the board may have been used between slices
(let [r (search/think {:ms fallback-slice-ms :max-ms fallback-slice-ms :contempt contempt
:depth (or (game/setting g :max-depth (game/to-move g)) 64)})
nodes (+ nodes (:nodes r))
ms (- (.now js/performance) start)
best (-> (if (or (nil? best) (>= (:depth r) (:depth best))) r best)
(assoc :reached (:seldepth r) :nodes nodes :ms ms :nps (js/Math.round (/ (* 1000 nodes) ms))))]
(swap! !engine merge (search-state g best))
(if (> ms (min fallback-ms (think-time g (game/to-move g))))
(finish-search! id ply g best)
(do (draw!) (js/setTimeout #(next-slice best nodes) 0))))))
nil 0)))
(defn- search!
"Search in the background worker, for the side's thinking time. Each completed iteration redraws
the bars; the best move found is played. If the worker cannot run, the page searches itself."
[id ply g]
(let [[fen texts] (game/since-irreversible (:fens g) (:moves g))
ms (think-time g (game/to-move g))]
(swap! !engine assoc :status :thinking)
(.search (host/checkers-host)
(worker/request "search" id fen texts (cond-> {"ms" ms "maxMs" ms "contempt" contempt}
(game/setting g :max-depth (game/to-move g))
(assoc "depth" (game/setting g :max-depth (game/to-move g)))))
(fn [^js msg]
(when (= id @!search-id)
(let [{:keys [type] :as report} (js->clj msg :keywordize-keys true)]
(case type
"info" (do (swap! !engine merge (search-state g report)) (draw!))
"best" (finish-search! id ply g report)
"error" (fallback! id ply g)
nil)))))))
(defn- computer-move!
"Let the computer move."
[]
(let [g @!game
id (swap! !search-id inc)]
(reset! !engine {:status :thinking :since (.now js/performance)})
(search! id (count (:moves g)) g)
(draw!)))
(defn- stop-thinking!
"Forget any search in progress, so that its reply is never played, and stop it. An idle worker
is kept, with what it has learnt."
[]
(swap! !search-id inc)
(.stop (host/checkers-host) true)
(reset! !engine {:status :idle}))
;; After every change
(defn- changed!
"Save and show the game, and let the computer move if it is its turn and the game is on the page.
The last search's figures stay until the next search."
[]
(save!)
(if (and @!mounted (computers-turn? @!game) (not (:paused? @!game)))
(computer-move!)
(do (swap! !engine assoc :status :idle) (draw!))))
(defn- start-game!
"Start game g. A new game clears what the search learnt about the last one."
[g]
(stop-thinking!)
(.stop (host/checkers-host) false)
(search/clear!)
(reset! !game g)
(announce! (str "New game: " (if-let [you (game/human-side g)]
(str "you play " (name you))
(if (game/humans-turn? g) (str "two players, " (side-name (game/to-move g)) " to move") "the computer plays itself"))))
(changed!))
(defn- note [text] (println (str ";; " text)))
;; The commands, reached as checkers/...
(defn- game-over-error [g]
(ex-info (str "The game is over: " (str/lower-case (result-text (:result g) g)))
{:pt/hint "(checkers/new-game!) sets up a new one"}))
(defn- parse-move
"The legal move the arguments of checkers/move! name, or an error saying why there is none."
[args]
(let [g @!game
text (cond (and (= 1 (count args)) (string? (first args))) (str/trim (first args))
(and (<= 2 (count args)) (every? integer? args)) (str/join "-" args)
:else nil)]
(when (nil? text)
(throw (ex-info (str (pr-str (apply list 'checkers/move! '!game args)) " is not a move")
{:pt/hint "give its squares, as (checkers/move! !game 11 15), or a jump's every square, as (checkers/move! !game 22 15 6); or write it as players do, as (checkers/move! !game \"22x15x6\")"})))
(let [found (do (board/set-position! (game/fen g)) (board/parse-move text))
jumps? (some-> (first (board/legal-moves)) board/jump?)]
(case (count found)
1 (first found)
0 (throw (ex-info (str (str/replace text #"\s+" "-") " is not a legal move here")
{:pt/hint (if jumps?
"a jump is forced: (checkers/moves @!game) lists the jumps"
"(checkers/moves @!game) lists the legal moves")}))
(throw (ex-info (str text " could be " (count found) " jumps: " (str/join ", " (map board/notation found)))
{:pt/hint "name every square the jump lands on, as (checkers/move! !game 22 15 6)"}))))))
(defn- this-game
"The game a command was given, which must be the page's, !game."
[a cmd]
(if (identical? a !game)
a
(throw (ex-info (str "(checkers/" cmd " …) takes the game first, as (checkers/" cmd " !game …)")
{:pt/hint "!game is the page's game, and @!game shows it"}))))
(defn- value "A game, from the game itself, its atom, or nothing, the page's." ([] @!game) ([g] (if (map? g) g @g)))
(defn move!
"Play a move for the side to move, and return it with its number, as \"1. 23-19\" or \"1...
11-15\", and the result if it ends the game. Name it by its squares, as (checkers/move! !game 23
19), a jump by every square it lands on, as (checkers/move! !game 22 15 6), or by where it
starts and ends when that is enough; or in a string, as players write it, as (checkers/move!
!game \"22x15x6\"). Whoever can jump must. A move made for the computer stops its thinking."
[a & args]
(this-game a "move!")
(let [g @!game]
(when (:result g) (throw (game-over-error g)))
(let [m (parse-move args)
mover (game/to-move g)
by-computer? @!replying]
(when-not by-computer? (stop-thinking!))
(when (:paused? g) (swap! !game assoc :paused? false)) ; a move resumes the game
(let [g (swap! !game game/play m)
text (peek (:moves g))]
(announce! (str (cond by-computer? "The computer" (= mover (game/human-side g)) "You" :else (side-name mover))
" played " (str/replace text "x" " takes to ")
(when (:result g) (str ". " (result-text (:result g) g)))))
(changed!)
(game/move-text g)))))
(def ^:private players-hint "(checkers/players! !game :human :computer) gives Black to you and White to the computer")
(defn- kept
"The game to keep as the one before a new game, for Take Back: g itself if it had a move, else
the one it kept."
[g]
(when g (if (seq (:moves g)) (dissoc g :previous) (:previous g))))
(defn new-game!
"Start a new game from the standard position, White to move: with you playing side, :black, the
computer moving first after Play, or :white, against the computer; or with a map of who plays :black and :white, :human or
:computer; or as the last game was played, with each side's settings. It waits for Play,
(checkers/resume! !game), or a person's first move. The game in progress is kept:
(checkers/take-back! !game), with no move to take back, goes back to it. Returns the game,
!game."
([] (new-game! {}))
([arg]
(let [g @!game
before {:players (:players g (game/playing :black)) :think-ms (:think-ms g) :max-depth (:max-depth g) :flipped? (:flipped? g)}
options (cond (#{:black :white} arg) (game/with-players before (game/playing arg)) ; the computer's settings go with it
(map? arg) (let [ps (merge (:players before) (select-keys arg [:black :white]))]
(when-not (every? #{:human :computer} (vals ps))
(throw (ex-info (str "There is no player " (pr-str (first (remove #{:human :computer} (vals ps)))))
{:pt/hint players-hint})))
(game/with-players before ps))
:else (throw (ex-info (str "There is no side " (pr-str arg))
{:pt/hint "(checkers/new-game! :black) or (checkers/new-game! :white)"})))]
(start-game! (assoc (game/new-game options) :paused? true :previous (kept g)))
!game)))
(def ^{:doc "The same as new-game!."} play! new-game!)
(defn players!
"Say who moves for each side from now on, :human or :computer, Black's first, in the game as it
stands: the computer can take either side, or both and play itself, and two people can play each
other on one board. The computer set to play itself waits for Play. Returns the players."
[a black white]
(this-game a "players!")
(when-let [bad (first (remove #{:human :computer} [black white]))]
(throw (ex-info (str "There is no player " (pr-str bad)) {:pt/hint players-hint})))
(let [before @!game
g (swap! !game game/set-players {:black black :white white})
side (game/to-move g)]
(announce! (str "Black: " (if (= black :human) "human" "the computer") ". White: " (if (= white :human) "human" "the computer")))
(if (and (= (game/player before side) (game/player g side)) (= (:paused? before) (:paused? g)))
(do (save!) (draw!))
(do (stop-thinking!) (changed!)))
(:players g)))
(defn pause!
"Pause the game: the computer stops thinking until (checkers/resume! !game), or a person's move,
resumes it. Returns :paused."
[a]
(this-game a "pause!")
(when (:result @!game) (throw (game-over-error @!game)))
(stop-thinking!)
(swap! !game assoc :paused? true)
(announce! "Paused")
(changed!)
:paused)
(defn resume!
"Go on with a paused game, or start a new one that waits to be started: the computer thinks if it
is its move. Returns :playing."
[a]
(this-game a "resume!")
(let [g @!game]
(when (:result g) (throw (game-over-error g)))
(swap! !game assoc :paused? false)
(announce! (if (empty? (:moves g)) "Started" "Resumed"))
(changed!)
:playing))
(defn take-back!
"Take back the last move, and stop any thinking: with a person playing, the computer's moves since
that person's last with it, so that it is their move again; when the computer plays itself, its
last move. With no move to take back, as after Reset Board, go back to the game before this one.
It never changes a setting, and a game that the computer is then to move in waits for Play. The
moves taken back stay in the move list, to play again with (checkers/go-to! !game n side).
Returns the moves taken back, newest first, or :previous-game."
[a]
(this-game a "take-back!")
(let [was @!game
[g taken] (game/take-back was)
paused (when (and (:paused? g) (not (:paused? was))) ", paused")]
(cond (= taken :previous-game) (do (stop-thinking!)
(.stop (host/checkers-host) false)
(reset! !game g)
(announce! (str "Back to the game before" paused))
(changed!)
:previous-game)
(seq taken) (do (stop-thinking!)
(reset! !game g)
(announce! (str "Took back " (str/join " and " taken) paused))
(changed!)
taken)
:else (do (note "nothing to take back") nil))))
(def ^{:doc "The same as take-back!."} undo! take-back!)
(defn go-to!
"Go back to the game as it was after the move numbered n of side, :black or :white, as
(checkers/go-to! !game 12 :white), the moves after it taken back; or on to one of the moves taken
back, which the move list shows after the game's, playing it again with those before it. A click
on a move in the list does this. It stops any thinking, and the game waits, paused, for Play or a
person's move, so that the settings can change first. Returns the move, as \"12... 11-15\"."
[a n side]
(this-game a "go-to!")
(when-not (and (integer? n) (#{:black :white} side))
(throw (ex-info (str (pr-str (list 'checkers/go-to! '!game n side)) " names no move")
{:pt/hint "a move's number and side, as (checkers/go-to! !game 12 :white) for White's 12th"})))
(let [was @!game
played (count (:moves was))
ply (game/ply-after was n side)]
(when-not (<= 1 ply (+ played (count (:later was))))
(throw (ex-info (str "There is no move " n " for " (side-name side) " in this game")
{:pt/hint "the moves in the move list, and those taken back after them, can be gone to"})))
(when-not (= ply played)
(stop-thinking!)
(reset! !game (game/go-to was ply))
(announce! (str (if (> ply played) "On to " "Back to ") (side-name side) "'s move " n ", " (peek (:moves @!game))
(when (:paused? @!game) ", paused")))
(changed!))
(game/move-text @!game)))
(defn- set-side!
"Set settings kept for each side, a map such as {:think-ms 500}: for side, or for both sides
when side is nil. The computer choosing that side's move starts again, with them."
[side settings]
(swap! !game (fn [g] (reduce-kv (fn [g k v] (reduce #(assoc-in %1 [k %2] v) g (if side [side] game/sides))) g settings)))
(save!)
(draw!)
(let [g @!game]
(when (and @!mounted (computers-turn? g) (not (:paused? g)) (or (nil? side) (= side (game/to-move g)))
(#{:thinking :fallback} (:status @!engine)))
(stop-thinking!)
(computer-move!))))
(defn- side-arg [cmd side]
(when-not (#{:black :white} side)
(throw (ex-info (str "There is no side " (pr-str side)) {:pt/hint (str "a side, :black or :white, as (checkers/" cmd " !game :white …)")}))))
(defn think!
"Set how long the computer thinks about each move from now on, in milliseconds, from 10 to
300,000: the settings offer 10 ms to 5 minutes. The longer it thinks, the stronger it plays. For
both sides, or for side, :black or :white. Returns the time set."
([a ms] (think! a nil ms))
([a side ms]
(this-game a "think!")
(when side (side-arg "think!" side))
(when-not (and (integer? ms) (<= 10 ms 300000))
(throw (ex-info (str "There is no thinking time " (pr-str ms)) {:pt/hint "a time in milliseconds, from 10 to 300,000, as (checkers/think! !game 250)"})))
(set-side! side {:think-ms ms})
ms))
(defn depth!
"Limit how many plies deep the computer searches, the page's Depth, from 1 to 64, or not, with 0
or nil, the default. The jumps a side must make are followed beyond it. It still stops when its
thinking time is up. For both sides, or for side, :black or :white. Returns the limit, or nil for
none."
([a n] (depth! a nil n))
([a side n]
(this-game a "depth!")
(when side (side-arg "depth!" side))
(when-not (or (nil? n) (and (integer? n) (<= 0 n 64)))
(throw (ex-info (str "There is no depth " (pr-str n)) {:pt/hint "a depth from 1 to 64, as (checkers/depth! !game 8), or 0 for none"})))
(let [n (when (and n (pos? n)) n)]
(set-side! side {:max-depth n})
n)))
(defn difficulty!
"Set how hard the computer plays, the page's Difficulty (owner, 2026-09-28): :novice, a Depth of
2 and 10 ms a move; :easy, 4 and 250 ms; :medium, 6 and 500 ms; :hard, 8 and 5 s; or :chessmate,
no limit to its depth and 30 s a move. For the side the computer plays against you, or for both
sides when it plays both or neither, or for side, :black or :white. Returns the difficulty."
([a level] (difficulty! a nil level))
([a side level]
(this-game a "difficulty!")
(when side (side-arg "difficulty!" side))
(let [settings (get difficulties level)]
(when-not settings
(throw (ex-info (str "There is no difficulty " (pr-str level))
{:pt/hint (str "a difficulty, " (str/join ", " (map str (keys difficulties))) ", as (checkers/difficulty! !game :easy)")})))
(set-side! (or side (some-> (game/human-side @!game) game/other)) settings)
level)))
(defn setup!
"Start a new game from a position in FEN, as (checkers/setup! !game \"W:W18,K27:B1,5,K22\"), with
the players and settings as they are. Returns the FEN as the game writes it. A FEN that names no
position a game can reach is refused, with the reason."
[a fen]
(this-game a "setup!")
(let [g @!game
new (try (game/new-game {:start-fen fen :players (:players g) :think-ms (:think-ms g) :max-depth (:max-depth g)
:flipped? (:flipped? g)})
(catch :default e
(throw (ex-info (ex-message e) {:pt/hint "(checkers/fen @!game) shows the present position's FEN"}))))]
(start-game! (assoc new :previous (kept g)))
(game/fen new)))
(defn flip!
"Turn the board round. Returns the side now at the bottom."
[a]
(this-game a "flip!")
(let [g (swap! !game update :flipped? not)]
(save!)
(draw!)
(game/bottom g)))
(defn resign!
"Resign the game: yours, against the computer, or the side to move's when two play. Returns the
result."
[a]
(this-game a "resign!")
(let [g @!game]
(when (:result g) (throw (game-over-error g)))
(when-not (some #(= :human (game/player g %)) game/sides)
(throw (ex-info "The computer plays both sides, and neither resigns" {:pt/hint players-hint})))
(stop-thinking!)
(let [g (swap! !game game/resign (or (game/human-side g) (game/to-move g)))]
(announce! (result-text (:result g) g))
(changed!)
(result-text (:result g) g))))
(defn board
"The position as eight strings, Black's back rank first, as players draw the board with Black at
the top: b and w for Black's and White's men, B and W for their kings, · for an empty square, and
a space for a light one. Of the page's game, or of g, a game or its atom."
([] (board !game))
([g]
(board/set-position! (game/fen (value g)))
(vec (for [row (range 8)]
(apply str (for [file (range 8)]
(if (= (mod (+ file row) 2) 1)
(glyphs (aget board/squares (+ (* row 4) (quot file 2))))
" ")))))))
(defn moves
"The legal moves of the side to move, as players write them: its jumps, if it has any, as it
must jump. Of the page's game, or of g, a game or its atom."
([] (moves !game))
([g] (mapv board/notation (game/legal-moves (value g)))))
(defn fen "The position, in FEN: the page's game's, or g's." ([] (fen !game)) ([g] (game/fen (value g))))
(defn pdn
"Print the game as PDN, Portable Draughts Notation: the page's game, or g, a game or its atom."
([] (pdn !game))
([g] (println (game/pdn (value g) (game/today)))))
(defn evaluate
"The evaluation of the position, without searching: the side it favours, :black, :white or
:neither, and its score from White's point of view, in men; and the side to move: of the page's
game, or of g, a game or its atom. The last search's score, when the computer has searched, is in
(checkers/game)."
([] (evaluate !game))
([g]
(let [g (value g)
score (white-score g)]
{:winning (winning score)
:score score
:to-move (game/to-move g)})))
(defn game
"The whole game, with what the computer is doing, in one map."
[]
(merge @!game (dissoc @!engine :since)))
;; On /checkers
(defn stop!
"Leave the game's page: stop any search, so that no reply is played, and release the board."
[]
(reset! !mounted false)
(stop-thinking!)
(save!)
(.stop (host/checkers-host) false) ; and end the worker, which holds 16 MB
(.unmount (host/checkers-host)))
(defn start!
"Show the game on /checkers: the one in memory, or the one browser storage holds, or a new one. A
game under way arrives paused, so that nothing plays until the visitor says so."
[]
(try (doseq [k ["pt87.checkers" "pt87.checkers2"]] (.removeItem js/localStorage k)) (catch :default _ nil)) ; the games kept under the keys before
(when-not @!game (reset! !game (or (restore) (game/new-game))))
(host/on-leave! stop!)
(reset! !mounted true)
(swap! !game game/arrive)
(.mount (host/checkers-host))
(reset! !engine {:status :idle})
(draw!))checkers.worker-main · 6 lines
(ns checkers.worker-main
"Checkers' compiled worker's entry point. Never evaluated on the page."
(:require
[checkers.worker :as worker]))
(worker/start!)