tests
parent
f265d24c0c
commit
7c07d6e6ec
|
@ -0,0 +1,51 @@
|
||||||
|
# 9mm
|
||||||
|
|
||||||
|
Introducing:
|
||||||
|
Nine Mens Morris
|
||||||
|
The Game
|
||||||
|
|
||||||
|
A game about moving cows
|
||||||
|
|
||||||
|
Featuring:
|
||||||
|
Fennel
|
||||||
|
The Language
|
||||||
|
|
||||||
|
By:
|
||||||
|
dozens
|
||||||
|
the human
|
||||||
|
|
||||||
|
## ABOUT
|
||||||
|
|
||||||
|
Do you know what Nine Mens Morris looks like?
|
||||||
|
It has three concentric rings, each containing eight spaces.
|
||||||
|
Here's what it looks like:
|
||||||
|
|
||||||
|
```
|
||||||
|
1-----2-----3
|
||||||
|
| | |
|
||||||
|
| 4---5---6 |
|
||||||
|
| | | | |
|
||||||
|
| | 7-8-9 | |
|
||||||
|
| | | | | |
|
||||||
|
0-1-2 3-4-5 +10
|
||||||
|
| | | | | |
|
||||||
|
| | 6-7-8 | |
|
||||||
|
| | | | |
|
||||||
|
| 9---0---1 | +20
|
||||||
|
| | |
|
||||||
|
2-----3-----4
|
||||||
|
```
|
||||||
|
|
||||||
|
## BACKGROUND
|
||||||
|
|
||||||
|
9mm is legit a great game.
|
||||||
|
|
||||||
|
One time i wrote an essay about the social contract implicit to nine mens morris:
|
||||||
|
https://write.tildeverse.org/dozens/nine-mens-morris-cultural-meanings-and-social-contracts
|
||||||
|
|
||||||
|
Kind of obsessed with this variation about COWS
|
||||||
|
https://en.wikipedia.org/wiki/Morabaraba
|
||||||
|
|
||||||
|
also look at these round cows
|
||||||
|
https://en.wikipedia.org/wiki/Spherical_cow
|
||||||
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
# list available recipes
|
||||||
|
default:
|
||||||
|
just --list --unsorted
|
||||||
|
|
||||||
|
# run tests
|
||||||
|
test:
|
||||||
|
for f in lib/*.test.fnl; do fennel $f | faucet; done
|
|
@ -0,0 +1,91 @@
|
||||||
|
(local neighbors
|
||||||
|
[
|
||||||
|
[1 2 10]
|
||||||
|
[2 1 3 5]
|
||||||
|
[3 2 15]
|
||||||
|
[4 5 11]
|
||||||
|
[5 2 4 6 8]
|
||||||
|
[6 5 14]
|
||||||
|
[7 8 12]
|
||||||
|
[8 5 7 9]
|
||||||
|
[9 8 13]
|
||||||
|
[10 1 11 22]
|
||||||
|
[11 4 10 12 19]
|
||||||
|
[12 7 11 16]
|
||||||
|
[13 9 14 18]
|
||||||
|
[14 6 13 15 21]
|
||||||
|
[15 3 14 24]
|
||||||
|
[16 12 17]
|
||||||
|
[17 16 18 20]
|
||||||
|
[18 13 17]
|
||||||
|
[19 11 20]
|
||||||
|
[20 17 19 21 23]
|
||||||
|
[21 14 20]
|
||||||
|
[22 10 23]
|
||||||
|
[23 20 22 24]
|
||||||
|
[24 15 23]
|
||||||
|
])
|
||||||
|
|
||||||
|
(local mills
|
||||||
|
[
|
||||||
|
[1 2 3]
|
||||||
|
[4 5 6]
|
||||||
|
[7 8 9]
|
||||||
|
[10 11 12]
|
||||||
|
[13 14 15]
|
||||||
|
[16 17 18]
|
||||||
|
[19 20 21]
|
||||||
|
[22 23 24]
|
||||||
|
[1 10 22]
|
||||||
|
[4 11 19]
|
||||||
|
[7 12 16]
|
||||||
|
[2 5 8]
|
||||||
|
[17 20 23]
|
||||||
|
[9 13 18]
|
||||||
|
[6 14 21]
|
||||||
|
[3 15 24]
|
||||||
|
])
|
||||||
|
|
||||||
|
; these are the only moves that are valid
|
||||||
|
; i am somewhat bothered by all the wasted space
|
||||||
|
; by 2-3A and 5-6A e.g.
|
||||||
|
; Incidentally these are all in order of appearance
|
||||||
|
; so when you find a match,
|
||||||
|
; you can also update that index of `moves` to the current player number
|
||||||
|
(local spaces [
|
||||||
|
"1A" "4A" "7A"
|
||||||
|
"2B" "4B" "6B"
|
||||||
|
"3C" "4C" "5C"
|
||||||
|
"1D" "2D" "3D"
|
||||||
|
"5D" "6D" "7D"
|
||||||
|
"3E" "4E" "5E"
|
||||||
|
"2F" "4F" "6F"
|
||||||
|
"1G" "4G" "7G"
|
||||||
|
])
|
||||||
|
|
||||||
|
; This is what the game board looks like
|
||||||
|
; it's also used to display the state of the game
|
||||||
|
; the Xs are converted to "%d" later for string templating
|
||||||
|
; they are Xs here so that it looks pretty =)
|
||||||
|
(local board [
|
||||||
|
" 1 2 3 4 5 6 7"
|
||||||
|
"A x-----x-----x" ;; 1 2 3
|
||||||
|
" | | |" ;;
|
||||||
|
"B | x---x---x |" ;; 4 5 6
|
||||||
|
" | | | | |" ;;
|
||||||
|
"C | | x-x-x | |" ;; 7 8 9
|
||||||
|
" | | | | | |" ;;
|
||||||
|
"D x-x-x x-x-x" ;; 10 11 12 13 14 15
|
||||||
|
" | | | | | |" ;;
|
||||||
|
"E | | x-x-x | |" ;; 16 17 18
|
||||||
|
" | | | | |" ;;
|
||||||
|
"F | x---x---x |" ;; 19 20 21
|
||||||
|
" | | |" ;;
|
||||||
|
"G x-----x-----x" ;; 22 23 24
|
||||||
|
])
|
||||||
|
|
||||||
|
{: board
|
||||||
|
: mills
|
||||||
|
: neighbors
|
||||||
|
: spaces}
|
||||||
|
|
|
@ -1,11 +1,17 @@
|
||||||
(let [{: contains } (require :lib.contains)]
|
(let [{: contains } (require :lib.contains)
|
||||||
(let [given "a list and an element it contains"
|
{: describe } (require :lib.test)
|
||||||
should "returns true"
|
{: describe :end test-end} (require :lib.test)
|
||||||
expected true
|
]
|
||||||
actual (contains [:apple :orange :pear] :apple)]
|
|
||||||
(assert (= actual expected) (.. "Given " given " should " should)))
|
(describe "contains()" (fn [t]
|
||||||
(let [given "a list and an element it does not contain"
|
(t {:given "a list and an element it contains"
|
||||||
should "returns false"
|
:should "returns true"
|
||||||
expected false
|
:expected true
|
||||||
actual (contains [:apple :orange :pear] :gorilla)]
|
:actual (contains [:apple :orange :pear] :apple)}
|
||||||
(assert (= actual expected) (.. "Given " given " should " should))))
|
)
|
||||||
|
(t {:given "a list and an element it does not contain"
|
||||||
|
:should "returns false"
|
||||||
|
:expected false
|
||||||
|
:actual (contains [:apple :orange :pear] :gorilla)
|
||||||
|
})
|
||||||
|
(test-end))))
|
||||||
|
|
|
@ -1,40 +1,41 @@
|
||||||
(local {: pprint} (require :lib.tableprint))
|
(let [{: pprint} (require :lib.tableprint)
|
||||||
|
{: describe :end test-end} (require :lib.test)
|
||||||
(let [{
|
{: Either : Left : Right } (require :lib.either)]
|
||||||
: Either
|
(describe "Either" (fn [t]
|
||||||
: Left
|
(t {:given "a new either"
|
||||||
: Right
|
:should "set its value correctly"
|
||||||
} (require :lib.either)]
|
:expected :poop
|
||||||
|
:actual (. (Either:new :poop) :value)
|
||||||
;; either
|
})
|
||||||
;(print "Either Inspection")
|
(t
|
||||||
;(pprint Either)
|
|
||||||
|
|
||||||
;; you can set and get values
|
|
||||||
(let [ v :poop x (Either:new v)]
|
|
||||||
(assert (= v x.value) (.. "The value is " v)))
|
|
||||||
|
|
||||||
(let [r (Right:new "rain")
|
(let [r (Right:new "rain")
|
||||||
map (r:map #(.. "b" $1))
|
map (r:map #(.. "b" $1))
|
||||||
expected :brain
|
expected :brain
|
||||||
actual (. map :value)
|
actual (. map :value)]
|
||||||
]
|
{:given "a Right of some value"
|
||||||
(assert (= expected actual) "You can map a Right value"))
|
:should "map"
|
||||||
|
expected
|
||||||
(let [l (Left:new "rain")
|
actual
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [ l (Left:new "rain")
|
||||||
map (l:map #(.. "b" $1))
|
map (l:map #(.. "b" $1))
|
||||||
expected :rain
|
expected :rain
|
||||||
actual (. map :value)
|
actual (. map :value)
|
||||||
]
|
]
|
||||||
(assert (= expected actual) "You can NOT map a Left value"))
|
{:given "a Left of some value"
|
||||||
|
:should "not map"
|
||||||
(let [e (Either.of "rank")
|
expected
|
||||||
|
actual
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [ e (Either.of "rank")
|
||||||
map (e:map #(.. "f" $1))
|
map (e:map #(.. "f" $1))
|
||||||
expected :frank
|
expected :frank
|
||||||
actual (. map :value)
|
actual (. map :value) ]
|
||||||
]
|
{:given "Either.of"
|
||||||
(assert (= expected actual) "You can map a Either.of"))
|
:should "map"
|
||||||
|
expected
|
||||||
|
actual
|
||||||
|
}))
|
||||||
)
|
(test-end))))
|
||||||
|
|
|
@ -0,0 +1,22 @@
|
||||||
|
;; thanks:
|
||||||
|
;; https://gist.github.com/sapphyrus/fd9aeb871e3ce966cc4b0b969f62f539
|
||||||
|
;; and antifennel
|
||||||
|
(fn deep-equals [o1 o2 ignore-mt]
|
||||||
|
(when (= o1 o2) (lua "return true"))
|
||||||
|
(local o1-type (type o1))
|
||||||
|
(local o2-type (type o2))
|
||||||
|
(when (not= o1-type o2-type) (lua "return false"))
|
||||||
|
(when (not= o1-type :table) (lua "return false"))
|
||||||
|
(when (not ignore-mt)
|
||||||
|
(local mt1 (getmetatable o1))
|
||||||
|
(when (and mt1 mt1.__eq)
|
||||||
|
(let [___antifnl_rtn_1___ (= o1 o2)] (lua "return ___antifnl_rtn_1___"))))
|
||||||
|
(each [key1 value1 (pairs o1)]
|
||||||
|
(local value2 (. o2 key1))
|
||||||
|
(when (or (= value2 nil) (= (deep-equals value1 value2 ignore-mt) false))
|
||||||
|
(lua "return false")))
|
||||||
|
(each [key2 _ (pairs o2)]
|
||||||
|
(when (= (. o1 key2) nil) (lua "return false")))
|
||||||
|
true)
|
||||||
|
|
||||||
|
{:equal deep-equals}
|
|
@ -0,0 +1,28 @@
|
||||||
|
(let [{: equal} (require :lib.equal)
|
||||||
|
{: describe :end test-end} (require :lib.test)]
|
||||||
|
(describe "equal()" (fn [t]
|
||||||
|
(t {:given "two equal tables"
|
||||||
|
:should "return true"
|
||||||
|
:expected true
|
||||||
|
:actual (equal [:orange :apple :pear] [:orange :apple :pear]) })
|
||||||
|
(t {:given "two different tables"
|
||||||
|
:should "return false"
|
||||||
|
:expected false
|
||||||
|
:actual (equal [:apple :pear] [:orange :apple :pear]) })
|
||||||
|
(t {:given "equal strings"
|
||||||
|
:should "be true"
|
||||||
|
:expected true
|
||||||
|
:actual (equal :apple :apple) })
|
||||||
|
(t {:given "different strings"
|
||||||
|
:should "be false"
|
||||||
|
:expected false
|
||||||
|
:actual (equal :apple :pear) })
|
||||||
|
(t {:given "equal bools"
|
||||||
|
:should "be true"
|
||||||
|
:expected true
|
||||||
|
:actual (equal true true) })
|
||||||
|
(t {:given "different strings"
|
||||||
|
:should "be false"
|
||||||
|
:expected false
|
||||||
|
:actual (equal true false) })
|
||||||
|
(test-end))))
|
|
@ -0,0 +1,6 @@
|
||||||
|
(fn flip [t]
|
||||||
|
"takes a table of {key value} and returns a table of {value key}"
|
||||||
|
(collect [k v (pairs t)] (values v k)))
|
||||||
|
|
||||||
|
{: flip}
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
(let [{: flip} (require :lib.flip)
|
||||||
|
{: describe :end test-end} (require :lib.test)]
|
||||||
|
(describe "flip()" (fn [t]
|
||||||
|
(let [input {:apple "red" :banana "yellow"}
|
||||||
|
expected {:red "apple" :yellow "banana"}
|
||||||
|
]
|
||||||
|
(t {:given "a table"
|
||||||
|
:should "flip that table!"
|
||||||
|
: expected
|
||||||
|
:actual (flip input)})
|
||||||
|
(test-end)))))
|
||||||
|
|
||||||
|
|
|
@ -1,11 +1,12 @@
|
||||||
(let [{: head } (require :lib.head)]
|
(let [{: head} (require :lib.head)
|
||||||
(let [given "a lift of elements"
|
{: describe :end test-end} (require :lib.test)]
|
||||||
it "returns the first element of a list"
|
(describe "head()" (fn [t]
|
||||||
expected :apple
|
(t {:given "a list of elements"
|
||||||
actual (head [:apple :orange :pear])]
|
:should "returns the first element of a list"
|
||||||
(assert (= actual expected) (.. "Given " given " it " it)))
|
:expected :apple
|
||||||
(let [given "an empty list"
|
:actual (head [:apple :orange :pear])})
|
||||||
it "returns an empty list"
|
(t {:given "an empty list"
|
||||||
expected 0
|
:should "returns an empty list"
|
||||||
actual (length (head []))]
|
:expected 0
|
||||||
(assert (= actual expected) (.. "Given " given " it " it))))
|
:actual (length (head []))})
|
||||||
|
(test-end))))
|
||||||
|
|
|
@ -1,13 +1,19 @@
|
||||||
(local {:contains contains} (require :lib.contains))
|
(local {: contains} (require :lib.contains))
|
||||||
(local {:head head} (require :lib.head))
|
(local {: flip} (require :lib.flip))
|
||||||
(local {:mill? mill?} (require :lib.mill))
|
(local {: head} (require :lib.head))
|
||||||
(local {:pprint pprint} (require :lib.tableprint))
|
(local {: keys} (require :lib.keys))
|
||||||
(local {:tail tail} (require :lib.tail))
|
(local {: mill?} (require :lib.mill))
|
||||||
|
(local {: pprint} (require :lib.tableprint))
|
||||||
|
(local {: slice} (require :lib.slice))
|
||||||
|
(local {: tail} (require :lib.tail))
|
||||||
|
|
||||||
{
|
{
|
||||||
:contains contains
|
: contains
|
||||||
:head head
|
: flip
|
||||||
:mill? mill?
|
: head
|
||||||
:pprint pprint
|
: keys
|
||||||
:tail tail
|
: mill?
|
||||||
|
: pprint
|
||||||
|
: slice
|
||||||
|
: tail
|
||||||
}
|
}
|
||||||
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
(fn keys [t]
|
||||||
|
"takes a table returns a sequential list of its keys"
|
||||||
|
(local out [])
|
||||||
|
(each [k v (pairs t)] (table.insert out k))
|
||||||
|
out)
|
||||||
|
|
||||||
|
{: keys}
|
|
@ -0,0 +1,13 @@
|
||||||
|
(let [{: keys} (require :lib.keys)
|
||||||
|
{: describe :end test-end} (require :lib.test)]
|
||||||
|
(describe "keys()" (fn [t]
|
||||||
|
(let [input {:apple :red :banana :yellow}
|
||||||
|
actual (keys input)
|
||||||
|
sorted (table.sort actual) ;; SIDE EFFECT!!
|
||||||
|
]
|
||||||
|
(t {:given "a table"
|
||||||
|
:should "returns a list of keys"
|
||||||
|
:expected [:apple :banana]
|
||||||
|
: actual})
|
||||||
|
(test-end)))))
|
||||||
|
|
55
lib/mill.fnl
55
lib/mill.fnl
|
@ -1,16 +1,45 @@
|
||||||
(local {: contains} (require :lib.contains))
|
(local {: contains} (require :lib.contains))
|
||||||
|
|
||||||
;; Does this move result in a mill?
|
|
||||||
(fn mill? [rules state move]
|
|
||||||
(let [candidates (icollect [_ mill (ipairs rules)] (if (contains mill move) mill))
|
|
||||||
candidate->moves (icollect [_ spaces (ipairs candidates)]
|
|
||||||
(icollect [_ space (ipairs spaces)] (. state space)) )
|
|
||||||
candidate-mill? (icollect [_ moves (ipairs candidate->moves)]
|
|
||||||
(accumulate [acc true
|
|
||||||
idx m (ipairs moves)]
|
|
||||||
(and acc (not= 0 m) (= (. moves idx) m)))) ]
|
|
||||||
(accumulate [acc true
|
|
||||||
_ x (ipairs candidate-mill?)]
|
|
||||||
(and acc x))))
|
|
||||||
|
|
||||||
{: mill?}
|
(fn get-candidates [all-mills next-move]
|
||||||
|
"a list of mills that contain next-move"
|
||||||
|
(icollect [_ mill (ipairs all-mills)] (if (contains mill next-move) mill)))
|
||||||
|
|
||||||
|
(fn candidates->moves [candidates current-moves move player]
|
||||||
|
"a list of the candidate mills expressed as current moves"
|
||||||
|
(icollect [_ spaces (ipairs candidates)]
|
||||||
|
(icollect [_ space (ipairs spaces)]
|
||||||
|
(if (= space move) :x (. current-moves space)))))
|
||||||
|
|
||||||
|
(fn moves->mills [spaces player]
|
||||||
|
"a list of bools if the candidate moves + player are all the same"
|
||||||
|
(let [next-move (icollect [_ y (ipairs spaces)]
|
||||||
|
(icollect [_ x (ipairs y)]
|
||||||
|
(if (= x :x) player x))) ]
|
||||||
|
(icollect [_ move (ipairs next-move)]
|
||||||
|
(accumulate [acc true
|
||||||
|
idx m (ipairs move)]
|
||||||
|
(and acc (= player m))))))
|
||||||
|
|
||||||
|
(fn any [t]
|
||||||
|
(accumulate [acc false
|
||||||
|
i x (ipairs t)]
|
||||||
|
(or acc x)))
|
||||||
|
|
||||||
|
|
||||||
|
(fn mill? [all-mills current-moves next-move player]
|
||||||
|
"Does the current move for the current player create a mill?"
|
||||||
|
(let [candidates (get-candidates all-mills next-move)
|
||||||
|
moves (candidates->moves candidates current-moves next-move player)
|
||||||
|
mills (moves->mills moves player)
|
||||||
|
result (any mills)]
|
||||||
|
result))
|
||||||
|
|
||||||
|
{: mill?
|
||||||
|
;; not for consumption,
|
||||||
|
;; just for testing:
|
||||||
|
: get-candidates
|
||||||
|
: candidates->moves
|
||||||
|
: moves->mills
|
||||||
|
: any
|
||||||
|
}
|
||||||
|
|
|
@ -1 +1,141 @@
|
||||||
;; TODO: test me
|
(let [{: describe
|
||||||
|
:end test-end} (require :lib.test)
|
||||||
|
{: mill?
|
||||||
|
: get-candidates
|
||||||
|
: candidates->moves
|
||||||
|
: moves->mills
|
||||||
|
: any
|
||||||
|
} (require :lib.mill)
|
||||||
|
{: mills } (require :lib.constants)
|
||||||
|
with-mills (partial mill? mills)]
|
||||||
|
|
||||||
|
|
||||||
|
(describe "Mill" (fn []
|
||||||
|
(describe "#get-candidates()" (fn [t]
|
||||||
|
(t
|
||||||
|
(let [move 3
|
||||||
|
expected [[1 2 3] [3 15 24]]
|
||||||
|
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
|
||||||
|
]
|
||||||
|
{:given (string.format "a move of %d" move)
|
||||||
|
:should "return [[1 2 3] [3 15 24]]"
|
||||||
|
: expected
|
||||||
|
:actual (get-candidates mills move)
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [move 1
|
||||||
|
expected [[1 2 3] [1 10 22]]
|
||||||
|
moves [ 0 0 0 ]
|
||||||
|
]
|
||||||
|
{:given (string.format "a move of %d" move)
|
||||||
|
:should "return [[1 2 3] [1 10 22]]"
|
||||||
|
: expected
|
||||||
|
:actual (get-candidates mills move)
|
||||||
|
}))))
|
||||||
|
|
||||||
|
|
||||||
|
(describe "#candidates->moves()" (fn [t]
|
||||||
|
(t
|
||||||
|
(let [candidates [[1 2 3] [1 10 22]]
|
||||||
|
moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2]
|
||||||
|
expected [[:x 1 1] [:x 2 2]]
|
||||||
|
move 1
|
||||||
|
player 2
|
||||||
|
]
|
||||||
|
{:given "a list of spaces and of current moves"
|
||||||
|
:should "return a map of spaces to moves"
|
||||||
|
: expected
|
||||||
|
:actual (candidates->moves candidates moves move player)
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [candidates [[1 2 3] [3 15 24]]
|
||||||
|
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
|
||||||
|
expected [[1 1 :x] [:x 0 0]]
|
||||||
|
move 3
|
||||||
|
player 1
|
||||||
|
]
|
||||||
|
{:given "a list of candidates and of current moves"
|
||||||
|
:should "return an x-map of spaces to moves"
|
||||||
|
: expected
|
||||||
|
:actual (candidates->moves candidates moves move player)
|
||||||
|
}))))
|
||||||
|
|
||||||
|
|
||||||
|
(describe "#moves->mills()" (fn [t]
|
||||||
|
(t
|
||||||
|
(let [spaces [[:x 1 1] [:x 2 2]]
|
||||||
|
moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2]
|
||||||
|
player 2
|
||||||
|
]
|
||||||
|
{:given "a list of spaces and of current moves"
|
||||||
|
:should "return a map of spaces to moves"
|
||||||
|
:expected [false true]
|
||||||
|
:actual (moves->mills spaces player)
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [spaces [[1 1 :x] [:x 0 0]]
|
||||||
|
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
|
||||||
|
player 1
|
||||||
|
]
|
||||||
|
{:given "a list of canditate-moves and of current moves"
|
||||||
|
:should "return a map of spaces to moves"
|
||||||
|
:expected [true false]
|
||||||
|
:actual (moves->mills spaces player)
|
||||||
|
}))))
|
||||||
|
|
||||||
|
|
||||||
|
(describe "#any()" (fn [t]
|
||||||
|
(t {:given "a table of false false true"
|
||||||
|
:should "return true"
|
||||||
|
:expected true
|
||||||
|
:actual (any [false false true])
|
||||||
|
})
|
||||||
|
(t {:given "a table of true false"
|
||||||
|
:should "return true"
|
||||||
|
:expected true
|
||||||
|
:actual (any [true false])
|
||||||
|
})
|
||||||
|
(t {:given "a single false"
|
||||||
|
:should "return false"
|
||||||
|
:expected false
|
||||||
|
:actual (any [false])
|
||||||
|
})
|
||||||
|
(t {:given "a single true"
|
||||||
|
:should "return true"
|
||||||
|
:expected true
|
||||||
|
:actual (any [true])
|
||||||
|
})))
|
||||||
|
|
||||||
|
|
||||||
|
(describe "#mill?()" (fn [t]
|
||||||
|
(t
|
||||||
|
(let [move 1
|
||||||
|
player 1
|
||||||
|
moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
|
||||||
|
with-moves (partial with-mills moves)]
|
||||||
|
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
|
||||||
|
:should "not be a mill"
|
||||||
|
:expected false
|
||||||
|
:actual (with-moves move player)
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [move 3
|
||||||
|
player 1
|
||||||
|
moves [1 1 0]
|
||||||
|
with-moves (partial with-mills moves)]
|
||||||
|
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
|
||||||
|
:should "be a mill"
|
||||||
|
:expected true
|
||||||
|
:actual (with-moves move player)
|
||||||
|
}))
|
||||||
|
(t
|
||||||
|
(let [move 3
|
||||||
|
player 1
|
||||||
|
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
|
||||||
|
with-moves (partial with-mills moves)]
|
||||||
|
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
|
||||||
|
:should "be a mill"
|
||||||
|
:expected true
|
||||||
|
:actual (with-moves move player)
|
||||||
|
}))))
|
||||||
|
(test-end))))
|
||||||
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
(fn slice [t start stop]
|
||||||
|
(fcollect [i start (or stop (length t))]
|
||||||
|
(. t i)))
|
||||||
|
|
||||||
|
{: slice}
|
|
@ -0,0 +1,19 @@
|
||||||
|
(let [{: slice} (require :lib.slice)
|
||||||
|
{: describe :end test-end} (require :lib.test)]
|
||||||
|
(describe "slice()" (fn [t]
|
||||||
|
(t
|
||||||
|
(let [t [:apple :orange :pear :banana :strawberry]
|
||||||
|
]
|
||||||
|
{:given "a list of elements and a start"
|
||||||
|
:should "return the list starting at start"
|
||||||
|
:expected [:orange :pear :banana :strawberry]
|
||||||
|
:actual (slice t 2)}))
|
||||||
|
(t
|
||||||
|
(let [t [:apple :orange :pear :banana :strawberry]
|
||||||
|
]
|
||||||
|
{:given "a list of elements and a start and a stop"
|
||||||
|
:should "return the items between the two"
|
||||||
|
:expected [:orange :pear]
|
||||||
|
:actual (slice t 2 3)}))
|
||||||
|
(test-end))))
|
||||||
|
|
|
@ -1 +1,19 @@
|
||||||
;; TODO: test me
|
(let [{: tail} (require :lib.tail)
|
||||||
|
{: describe :end test-end} (require :lib.test)]
|
||||||
|
(describe "tail()" (fn [t]
|
||||||
|
(t {:given "a list"
|
||||||
|
:should "return it minus the head"
|
||||||
|
:expected [:apple :pear]
|
||||||
|
:actual (tail [:orange :apple :pear])
|
||||||
|
})
|
||||||
|
(t {:given "a single item list"
|
||||||
|
:should "return empty list"
|
||||||
|
:expected []
|
||||||
|
:actual (tail [:orange])
|
||||||
|
})
|
||||||
|
(t {:given "an empty list"
|
||||||
|
:should "return empty list"
|
||||||
|
:expected []
|
||||||
|
:actual (tail [])
|
||||||
|
})
|
||||||
|
(test-end))))
|
||||||
|
|
|
@ -0,0 +1,52 @@
|
||||||
|
(local {: pprint} (require :lib.tableprint))
|
||||||
|
(local {: equal} (require :lib.equal))
|
||||||
|
|
||||||
|
(var plan 0)
|
||||||
|
|
||||||
|
(fn once [funky]
|
||||||
|
(var bang false)
|
||||||
|
(fn [...]
|
||||||
|
(if (not bang)
|
||||||
|
(do
|
||||||
|
(funky ...)
|
||||||
|
(set bang true)))))
|
||||||
|
|
||||||
|
(fn test [obj]
|
||||||
|
(let [{: given : should : actual : expected} obj
|
||||||
|
ok (if (equal actual expected) :ok "not ok")
|
||||||
|
description (.. "Given " given " should " should)
|
||||||
|
]
|
||||||
|
(set plan (+ 1 plan))
|
||||||
|
(print (.. ok " " plan " - " description))
|
||||||
|
(if (= "not ok" ok)
|
||||||
|
(do
|
||||||
|
(print " ---")
|
||||||
|
(if (= :table (type expected))
|
||||||
|
(do
|
||||||
|
(print (.. " expected: " ))
|
||||||
|
(pprint expected))
|
||||||
|
(print (.. " expected: " (tostring expected))))
|
||||||
|
(if (= :table (type actual))
|
||||||
|
(do
|
||||||
|
(print (.. " actual: " ))
|
||||||
|
(pprint actual))
|
||||||
|
(print (.. " actual: " (tostring actual))))
|
||||||
|
(print " ...")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
))
|
||||||
|
|
||||||
|
(local print-header (once (fn [] (print "TAP version 14"))))
|
||||||
|
|
||||||
|
(fn desc [str cb]
|
||||||
|
(print-header)
|
||||||
|
(print (.. "#" str))
|
||||||
|
(cb test)
|
||||||
|
)
|
||||||
|
(fn end []
|
||||||
|
(print (.. 1 ".." plan))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{:describe desc
|
||||||
|
: end}
|
|
@ -0,0 +1,19 @@
|
||||||
|
(let [{: describe :end test-end} (require :lib.test)]
|
||||||
|
(fn add [x y] (let [x (or x 0)
|
||||||
|
y (or y 0)]
|
||||||
|
(+ x y)))
|
||||||
|
(describe "add()" (fn [test]
|
||||||
|
(let [should "return the right number"]
|
||||||
|
(test {:given "two numbers"
|
||||||
|
: should
|
||||||
|
:actual (add 2 3)
|
||||||
|
:expected 5})
|
||||||
|
(test {:given "no arguments"
|
||||||
|
:should "return 0"
|
||||||
|
:actual (add)
|
||||||
|
:expected 0})
|
||||||
|
(test {:given "zero"
|
||||||
|
: should
|
||||||
|
:actual (add 0 4)
|
||||||
|
:expected 4}))
|
||||||
|
(test-end))))
|
224
main.fnl
224
main.fnl
|
@ -1,41 +1,16 @@
|
||||||
; Introducing:
|
|
||||||
; Nine Mens Morris
|
|
||||||
; The Game
|
|
||||||
;
|
|
||||||
; Featuring:
|
|
||||||
; Fennel
|
|
||||||
; The Language
|
|
||||||
;
|
|
||||||
; By:
|
|
||||||
; dozens
|
|
||||||
; the human
|
|
||||||
;
|
|
||||||
; Do you know what Nine Mens Morris looks like?
|
|
||||||
; It has three concentric rings, each containing eight spaces.
|
|
||||||
; Here's what it looks like:
|
|
||||||
;
|
|
||||||
; 1-----2-----3
|
|
||||||
; | | |
|
|
||||||
; | 4---5---6 |
|
|
||||||
; | | | | |
|
|
||||||
; | | 7-8-9 | |
|
|
||||||
; | | | | | |
|
|
||||||
; 0-1-2 3-4-5 +10
|
|
||||||
; | | | | | |
|
|
||||||
; | | 6-7-8 | |
|
|
||||||
; | | | | |
|
|
||||||
; | 9---0---1 | +20
|
|
||||||
; | | |
|
|
||||||
; 2-----3-----4
|
|
||||||
|
|
||||||
|
|
||||||
;; helper and utility functions
|
;; helper and utility functions
|
||||||
(local {
|
(local {
|
||||||
:contains contains
|
: contains
|
||||||
:head head
|
: head
|
||||||
|
: flip
|
||||||
|
: pprint
|
||||||
|
: slice
|
||||||
:mill? mill-maker
|
:mill? mill-maker
|
||||||
:pprint pprint
|
|
||||||
} (require :lib.index))
|
} (require :lib.index))
|
||||||
|
;; constants...more like just strings
|
||||||
|
(local const (require :lib.constants))
|
||||||
|
;; front-loading mill with a partial
|
||||||
|
(local mill? (partial mill-maker const.mills))
|
||||||
|
|
||||||
|
|
||||||
; there are three phases of play:
|
; there are three phases of play:
|
||||||
|
@ -43,19 +18,19 @@
|
||||||
; (plus one for capturing)
|
; (plus one for capturing)
|
||||||
; (plus one for complete)
|
; (plus one for complete)
|
||||||
(local stages {
|
(local stages {
|
||||||
:placing 1
|
:placing 1 ;; placing the cows
|
||||||
:moving 2
|
:moving 2 ;; moving the cows
|
||||||
:flying 3
|
:flying 3 ;; flying the cows
|
||||||
:capture 4
|
:capture 4 ;; capture a cow (we do not shoot cows)
|
||||||
:complete 5
|
:complete 5 ;; no more cows!
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
; there are two players
|
; there are two players
|
||||||
; their names are LUIGI and MARIO
|
; their names are LUIGI and MARIO
|
||||||
(local player {
|
(local player {
|
||||||
:one 1 ;; luigi
|
:one 1 ;; luigi has light cows
|
||||||
:two 2 ;; mario
|
:two 2 ;; mario has DARK cows >:)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
@ -68,67 +43,14 @@
|
||||||
(local moves (fcollect [i 1 24] 0))
|
(local moves (fcollect [i 1 24] 0))
|
||||||
|
|
||||||
|
|
||||||
(local rules {
|
|
||||||
; what moves are legal from each space
|
|
||||||
; slash what neighbors does each space have
|
|
||||||
:neighbors [
|
|
||||||
[1 2 10]
|
|
||||||
[2 1 3 5]
|
|
||||||
[3 2 15]
|
|
||||||
[4 5 11]
|
|
||||||
[5 2 4 6 8]
|
|
||||||
[6 5 14]
|
|
||||||
[7 8 12]
|
|
||||||
[8 5 7 9]
|
|
||||||
[9 8 13]
|
|
||||||
[10 1 11 22]
|
|
||||||
[11 4 10 12 19]
|
|
||||||
[12 7 11 16]
|
|
||||||
[13 9 14 18]
|
|
||||||
[14 6 13 15 21]
|
|
||||||
[15 3 14 24]
|
|
||||||
[16 12 17]
|
|
||||||
[17 16 18 20]
|
|
||||||
[18 13 17]
|
|
||||||
[19 11 20]
|
|
||||||
[20 17 19 21 23]
|
|
||||||
[21 14 20]
|
|
||||||
[22 10 23]
|
|
||||||
[23 20 22 24]
|
|
||||||
[24 15 23]
|
|
||||||
]
|
|
||||||
; sixteen combinations of spaces form a mill
|
|
||||||
:mills [
|
|
||||||
[1 2 3]
|
|
||||||
[4 5 6]
|
|
||||||
[7 8 9]
|
|
||||||
[10 11 12]
|
|
||||||
[13 14 15]
|
|
||||||
[16 17 18]
|
|
||||||
[19 20 21]
|
|
||||||
[22 23 24]
|
|
||||||
[1 10 22]
|
|
||||||
[4 11 19]
|
|
||||||
[7 12 16]
|
|
||||||
[2 5 8]
|
|
||||||
[17 20 23]
|
|
||||||
[9 13 18]
|
|
||||||
[6 14 21]
|
|
||||||
[3 15 24]
|
|
||||||
]
|
|
||||||
})
|
|
||||||
|
|
||||||
(fn mill? [state move] (partial mill-maker rules.mills))
|
|
||||||
|
|
||||||
|
|
||||||
; game state object
|
; game state object
|
||||||
(local game {
|
(local game {
|
||||||
:player player.one
|
:player player.one
|
||||||
:stage stages.placing
|
:stage stages.placing
|
||||||
:update (fn [self move]
|
:update (fn [self move]
|
||||||
(if (mill? moves move)
|
(if (mill? moves move self.player)
|
||||||
(do
|
(do
|
||||||
(print "MILLLLLLLLLLLLL!")
|
(print "Mooooooo")
|
||||||
(tset self :stage stages.capture)
|
(tset self :stage stages.capture)
|
||||||
)
|
)
|
||||||
(tset self :player (if (= player.one self.player) player.two player.one))
|
(tset self :player (if (= player.one self.player) player.two player.one))
|
||||||
|
@ -137,93 +59,59 @@
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
(fn string-upper [s]
|
||||||
|
(.. (string.upper (string.sub s 1 1)) (string.sub s 2)))
|
||||||
|
|
||||||
; This is what the game board looks like
|
|
||||||
; it's also used to display the state of the game
|
|
||||||
; the Xs are converted to "%d" later for string templating
|
|
||||||
; they are Xs here so that it looks pretty =)
|
|
||||||
(local board [
|
|
||||||
" 1 2 3 4 5 6 7"
|
|
||||||
"A x-----x-----x"
|
|
||||||
" | | |"
|
|
||||||
"B | x---x---x |"
|
|
||||||
" | | | | |"
|
|
||||||
"C | | x-x-x | |"
|
|
||||||
" | | | | | |"
|
|
||||||
"D x-x-x x-x-x"
|
|
||||||
" | | | | | |"
|
|
||||||
"E | | x-x-x | |"
|
|
||||||
" | | | | |"
|
|
||||||
"F | x---x---x |"
|
|
||||||
" | | |"
|
|
||||||
"G x-----x-----x"
|
|
||||||
])
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; Print! That! Board!
|
; Print! That! Board!
|
||||||
(fn print-board [board moves]
|
(fn print-board [board moves]
|
||||||
(var total-count -2) ; lol, m-a-g-i-c
|
(var index 1)
|
||||||
; just kidding, it's so that -2 + 3 = 1
|
|
||||||
; which is where i want to start indexing my table
|
|
||||||
(each [_ row (ipairs board)]
|
(each [_ row (ipairs board)]
|
||||||
(let [(template count) (string.gsub row "x" "%%d")]
|
(let [(row-template slots) (string.gsub row "x" "%%d")]
|
||||||
(if (> count 0)
|
(if (> slots 0)
|
||||||
(do
|
(do
|
||||||
(set total-count (+ total-count count)) ; where i need that magic number on first iteration
|
(let [offset (+ index slots)
|
||||||
(print (string.format template (select total-count (table.unpack moves)))))
|
myslice (slice moves index offset)]
|
||||||
(print row)))))
|
(print (string.format row-template (table.unpack myslice)))
|
||||||
; `select` above does NOT do what i thought it did.
|
(set index offset)))
|
||||||
; i thought it would return the first x values given (select x values)
|
(print row))))
|
||||||
; instead it returns the rest of the table having discarded the first x values
|
(print (.. "Stage: " (string-upper (. (flip stages) game.stage))))
|
||||||
; i think that `pick-values` probably does what i thought `select` does
|
(print (.. "Player " game.player "'s turn:")))
|
||||||
|
|
||||||
|
|
||||||
; these are the only moves that are valid
|
|
||||||
; i am somewhat bothered by all the wasted space
|
|
||||||
; by 2-3A and 5-6A e.g.
|
|
||||||
; Incidentally these are all in order of appearance
|
|
||||||
; so when you find a match,
|
|
||||||
; you can also update that index of `moves` to the current player number
|
|
||||||
(local valid-spaces [
|
|
||||||
"1A" "4A" "7A"
|
|
||||||
"2B" "4B" "6B"
|
|
||||||
"3C" "4C" "5C"
|
|
||||||
"1D" "2D" "3D"
|
|
||||||
"5D" "6D" "7D"
|
|
||||||
"3E" "4E" "5E"
|
|
||||||
"2F" "4F" "5F"
|
|
||||||
"1G" "4G" "7G"
|
|
||||||
])
|
|
||||||
; add the inverse of each valid move
|
; add the inverse of each valid move
|
||||||
; e.g. 1A = A1
|
; e.g. 1A = A1
|
||||||
(fn add-reverse-moves []
|
(fn add-reverse-moves []
|
||||||
(let [reversed (icollect [_ v (ipairs valid-spaces)] (string.reverse v))]
|
(let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))]
|
||||||
(each [_ v (ipairs reversed)]
|
(each [_ v (ipairs reversed)]
|
||||||
(table.insert valid-spaces v))))
|
(table.insert const.spaces v)))) ;; oh nooooo i'm mutating a const????
|
||||||
(add-reverse-moves)
|
(add-reverse-moves)
|
||||||
|
|
||||||
|
|
||||||
; does the move exist within the domain of valid spaces
|
; does the move exist within the domain of valid spaces
|
||||||
(fn space-exists? [m] (contains valid-spaces (string.upper m)))
|
(fn space-exists? [m] (contains const.spaces (string.upper m)))
|
||||||
|
|
||||||
; return the numerical index of a "A1" formatted move
|
|
||||||
|
; return the numerical index (1-24) of a [A-Za-z0-9] formatted move
|
||||||
(fn index-of-move [m]
|
(fn index-of-move [m]
|
||||||
(let [ upper (string.upper m)
|
(let [upper (string.upper m)
|
||||||
rev (string.reverse upper)
|
rev (string.reverse upper)
|
||||||
idx (head (icollect [i v (ipairs valid-spaces)]
|
idx (head (icollect [i v (ipairs const.spaces)]
|
||||||
(if (or (= v upper) (= v rev)) i)))
|
(if (or (= v upper) (= v rev)) i)))]
|
||||||
]
|
|
||||||
idx))
|
idx))
|
||||||
|
|
||||||
; is the space represented by a move ("A1") unoccupied?
|
; is the space represented by a [A-Za-z0-9] move unoccupied?
|
||||||
(fn space-is-unoccupied? [m]
|
(fn space-is-unoccupied? [m]
|
||||||
(let [unoccupied? 0]
|
(let [unoccupied? 0] ; i.e. is move equal to 0
|
||||||
(= unoccupied? (. moves (index-of-move m)))))
|
(= unoccupied? (. moves (index-of-move m)))))
|
||||||
|
|
||||||
|
|
||||||
|
(fn space-is-occupied-by-opponent? [m]
|
||||||
|
(let [opponent (if (= game.player 1) 2 1)]
|
||||||
|
(= opponent (. moves (index-of-move m)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; is this a legal move?
|
; is this a legal move?
|
||||||
; TODO: maybe some functional error handling here?
|
; TODO: maybe some functional error handling here?
|
||||||
; https://mostly-adequate.gitbook.io/mostly-adequate-guide/ch08#pure-error-handling
|
; https://mostly-adequate.gitbook.io/mostly-adequate-guide/ch08#pure-error-handling
|
||||||
|
@ -237,30 +125,34 @@
|
||||||
(or
|
(or
|
||||||
(and
|
(and
|
||||||
(= stages.placing game.stage)
|
(= stages.placing game.stage)
|
||||||
(or (space-exists? move) (print "That space does not exist!\nHint: 1a 1A A1 a1 are all valid moves."))
|
(or (space-exists? move)
|
||||||
(or (space-is-unoccupied? move) (print "That space is occupied!"))))
|
(print "That space does not exist!\nHint: 1a 1A A1 a1 are all equal moves."))
|
||||||
|
(or (space-is-unoccupied? move)
|
||||||
|
(print "That space is occupied!")))
|
||||||
(and
|
(and
|
||||||
;; TODO: add capturing phase
|
;; TODO: add capturing phase
|
||||||
(= stages.capturing game.stage)
|
(= stages.capturing game.stage)
|
||||||
|
(or (space-is-occupied-by-opponent? move)
|
||||||
|
(print "Choose an opponent's piece to remove."))
|
||||||
)
|
)
|
||||||
(and
|
(and
|
||||||
;; TODO: add flying phase
|
;; TODO: add flying phase
|
||||||
(= stages.flying game.stage)
|
(= stages.flying game.stage)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; get player input
|
; get player input
|
||||||
(fn get-move []
|
(fn get-move []
|
||||||
(print (.. "Player " game.player "'s turn:"))
|
|
||||||
(io.read))
|
(io.read))
|
||||||
|
|
||||||
|
|
||||||
(fn main []
|
(fn main []
|
||||||
;; game loop
|
;; game loop
|
||||||
(while (not (= game.stage stages.complete))
|
(while (not (= game.stage stages.complete))
|
||||||
(print-board board moves)
|
(print-board const.board moves)
|
||||||
|
|
||||||
;; validation loop
|
;; validation loop
|
||||||
(var is-valid false)
|
(var is-valid false)
|
||||||
|
@ -268,12 +160,14 @@
|
||||||
(while (not is-valid)
|
(while (not is-valid)
|
||||||
(set move (get-move))
|
(set move (get-move))
|
||||||
(set is-valid (valid-move? move))
|
(set is-valid (valid-move? move))
|
||||||
|
(let [idx (index-of-move move)]
|
||||||
(if (not is-valid)
|
(if (not is-valid)
|
||||||
(print "Try again.")
|
(print "Try again.")
|
||||||
(do
|
(do
|
||||||
(print (.. "You chose " move))
|
(print (.. "You chose " move))
|
||||||
(tset moves (index-of-move move) game.player)
|
(tset moves idx game.player)
|
||||||
(game:update move)
|
(game:update idx)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue