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 [given "a list and an element it contains"
|
||||
should "returns true"
|
||||
expected true
|
||||
actual (contains [:apple :orange :pear] :apple)]
|
||||
(assert (= actual expected) (.. "Given " given " should " should)))
|
||||
(let [given "a list and an element it does not contain"
|
||||
should "returns false"
|
||||
expected false
|
||||
actual (contains [:apple :orange :pear] :gorilla)]
|
||||
(assert (= actual expected) (.. "Given " given " should " should))))
|
||||
(let [{: contains } (require :lib.contains)
|
||||
{: describe } (require :lib.test)
|
||||
{: describe :end test-end} (require :lib.test)
|
||||
]
|
||||
|
||||
(describe "contains()" (fn [t]
|
||||
(t {:given "a list and an element it contains"
|
||||
:should "returns true"
|
||||
:expected true
|
||||
:actual (contains [:apple :orange :pear] :apple)}
|
||||
)
|
||||
(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 [{
|
||||
: Either
|
||||
: Left
|
||||
: Right
|
||||
} (require :lib.either)]
|
||||
|
||||
;; either
|
||||
;(print "Either Inspection")
|
||||
;(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")
|
||||
map (r:map #(.. "b" $1))
|
||||
expected :brain
|
||||
actual (. map :value)
|
||||
]
|
||||
(assert (= expected actual) "You can map a Right value"))
|
||||
|
||||
(let [l (Left:new "rain")
|
||||
map (l:map #(.. "b" $1))
|
||||
expected :rain
|
||||
actual (. map :value)
|
||||
]
|
||||
(assert (= expected actual) "You can NOT map a Left value"))
|
||||
|
||||
(let [e (Either.of "rank")
|
||||
map (e:map #(.. "f" $1))
|
||||
expected :frank
|
||||
actual (. map :value)
|
||||
]
|
||||
(assert (= expected actual) "You can map a Either.of"))
|
||||
|
||||
|
||||
|
||||
)
|
||||
(let [{: pprint} (require :lib.tableprint)
|
||||
{: describe :end test-end} (require :lib.test)
|
||||
{: Either : Left : Right } (require :lib.either)]
|
||||
(describe "Either" (fn [t]
|
||||
(t {:given "a new either"
|
||||
:should "set its value correctly"
|
||||
:expected :poop
|
||||
:actual (. (Either:new :poop) :value)
|
||||
})
|
||||
(t
|
||||
(let [r (Right:new "rain")
|
||||
map (r:map #(.. "b" $1))
|
||||
expected :brain
|
||||
actual (. map :value)]
|
||||
{:given "a Right of some value"
|
||||
:should "map"
|
||||
expected
|
||||
actual
|
||||
}))
|
||||
(t
|
||||
(let [ l (Left:new "rain")
|
||||
map (l:map #(.. "b" $1))
|
||||
expected :rain
|
||||
actual (. map :value)
|
||||
]
|
||||
{:given "a Left of some value"
|
||||
:should "not map"
|
||||
expected
|
||||
actual
|
||||
}))
|
||||
(t
|
||||
(let [ e (Either.of "rank")
|
||||
map (e:map #(.. "f" $1))
|
||||
expected :frank
|
||||
actual (. map :value) ]
|
||||
{:given "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 [given "a lift of elements"
|
||||
it "returns the first element of a list"
|
||||
expected :apple
|
||||
actual (head [:apple :orange :pear])]
|
||||
(assert (= actual expected) (.. "Given " given " it " it)))
|
||||
(let [given "an empty list"
|
||||
it "returns an empty list"
|
||||
expected 0
|
||||
actual (length (head []))]
|
||||
(assert (= actual expected) (.. "Given " given " it " it))))
|
||||
(let [{: head} (require :lib.head)
|
||||
{: describe :end test-end} (require :lib.test)]
|
||||
(describe "head()" (fn [t]
|
||||
(t {:given "a list of elements"
|
||||
:should "returns the first element of a list"
|
||||
:expected :apple
|
||||
:actual (head [:apple :orange :pear])})
|
||||
(t {:given "an empty list"
|
||||
:should "returns an empty list"
|
||||
:expected 0
|
||||
:actual (length (head []))})
|
||||
(test-end))))
|
||||
|
|
|
|||
|
|
@ -1,13 +1,19 @@
|
|||
(local {:contains contains} (require :lib.contains))
|
||||
(local {:head head} (require :lib.head))
|
||||
(local {:mill? mill?} (require :lib.mill))
|
||||
(local {:pprint pprint} (require :lib.tableprint))
|
||||
(local {:tail tail} (require :lib.tail))
|
||||
(local {: contains} (require :lib.contains))
|
||||
(local {: flip} (require :lib.flip))
|
||||
(local {: head} (require :lib.head))
|
||||
(local {: keys} (require :lib.keys))
|
||||
(local {: mill?} (require :lib.mill))
|
||||
(local {: pprint} (require :lib.tableprint))
|
||||
(local {: slice} (require :lib.slice))
|
||||
(local {: tail} (require :lib.tail))
|
||||
|
||||
{
|
||||
:contains contains
|
||||
:head head
|
||||
:mill? mill?
|
||||
:pprint pprint
|
||||
:tail tail
|
||||
: contains
|
||||
: flip
|
||||
: head
|
||||
: keys
|
||||
: 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))
|
||||
|
||||
;; 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))))
|
||||
236
main.fnl
236
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
|
||||
(local {
|
||||
:contains contains
|
||||
:head head
|
||||
: contains
|
||||
: head
|
||||
: flip
|
||||
: pprint
|
||||
: slice
|
||||
:mill? mill-maker
|
||||
:pprint pprint
|
||||
} (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:
|
||||
|
|
@ -43,19 +18,19 @@
|
|||
; (plus one for capturing)
|
||||
; (plus one for complete)
|
||||
(local stages {
|
||||
:placing 1
|
||||
:moving 2
|
||||
:flying 3
|
||||
:capture 4
|
||||
:complete 5
|
||||
:placing 1 ;; placing the cows
|
||||
:moving 2 ;; moving the cows
|
||||
:flying 3 ;; flying the cows
|
||||
:capture 4 ;; capture a cow (we do not shoot cows)
|
||||
:complete 5 ;; no more cows!
|
||||
})
|
||||
|
||||
|
||||
; there are two players
|
||||
; their names are LUIGI and MARIO
|
||||
(local player {
|
||||
:one 1 ;; luigi
|
||||
:two 2 ;; mario
|
||||
:one 1 ;; luigi has light cows
|
||||
:two 2 ;; mario has DARK cows >:)
|
||||
})
|
||||
|
||||
|
||||
|
|
@ -68,67 +43,14 @@
|
|||
(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
|
||||
(local game {
|
||||
:player player.one
|
||||
:stage stages.placing
|
||||
:update (fn [self move]
|
||||
(if (mill? moves move)
|
||||
(if (mill? moves move self.player)
|
||||
(do
|
||||
(print "MILLLLLLLLLLLLL!")
|
||||
(print "Mooooooo")
|
||||
(tset self :stage stages.capture)
|
||||
)
|
||||
(tset self :player (if (= player.one self.player) player.two player.one))
|
||||
|
|
@ -137,93 +59,59 @@
|
|||
})
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
; 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"
|
||||
])
|
||||
|
||||
|
||||
(fn string-upper [s]
|
||||
(.. (string.upper (string.sub s 1 1)) (string.sub s 2)))
|
||||
|
||||
|
||||
; Print! That! Board!
|
||||
(fn print-board [board moves]
|
||||
(var total-count -2) ; lol, m-a-g-i-c
|
||||
; just kidding, it's so that -2 + 3 = 1
|
||||
; which is where i want to start indexing my table
|
||||
(var index 1)
|
||||
(each [_ row (ipairs board)]
|
||||
(let [(template count) (string.gsub row "x" "%%d")]
|
||||
(if (> count 0)
|
||||
(let [(row-template slots) (string.gsub row "x" "%%d")]
|
||||
(if (> slots 0)
|
||||
(do
|
||||
(set total-count (+ total-count count)) ; where i need that magic number on first iteration
|
||||
(print (string.format template (select total-count (table.unpack moves)))))
|
||||
(print row)))))
|
||||
; `select` above does NOT do what i thought it did.
|
||||
; i thought it would return the first x values given (select x values)
|
||||
; instead it returns the rest of the table having discarded the first x values
|
||||
; i think that `pick-values` probably does what i thought `select` does
|
||||
(let [offset (+ index slots)
|
||||
myslice (slice moves index offset)]
|
||||
(print (string.format row-template (table.unpack myslice)))
|
||||
(set index offset)))
|
||||
(print row))))
|
||||
(print (.. "Stage: " (string-upper (. (flip stages) game.stage))))
|
||||
(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
|
||||
; e.g. 1A = A1
|
||||
(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)]
|
||||
(table.insert valid-spaces v))))
|
||||
(table.insert const.spaces v)))) ;; oh nooooo i'm mutating a const????
|
||||
(add-reverse-moves)
|
||||
|
||||
|
||||
; 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]
|
||||
(let [ upper (string.upper m)
|
||||
rev (string.reverse upper)
|
||||
idx (head (icollect [i v (ipairs valid-spaces)]
|
||||
(if (or (= v upper) (= v rev)) i)))
|
||||
]
|
||||
(let [upper (string.upper m)
|
||||
rev (string.reverse upper)
|
||||
idx (head (icollect [i v (ipairs const.spaces)]
|
||||
(if (or (= v upper) (= v rev)) i)))]
|
||||
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]
|
||||
(let [unoccupied? 0]
|
||||
(let [unoccupied? 0] ; i.e. is move equal to 0
|
||||
(= 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?
|
||||
; TODO: maybe some functional error handling here?
|
||||
; https://mostly-adequate.gitbook.io/mostly-adequate-guide/ch08#pure-error-handling
|
||||
|
|
@ -237,30 +125,34 @@
|
|||
(or
|
||||
(and
|
||||
(= 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-is-unoccupied? move) (print "That space is occupied!"))))
|
||||
(or (space-exists? move)
|
||||
(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
|
||||
;; TODO: add capturing phase
|
||||
(= stages.capturing game.stage)
|
||||
(or (space-is-occupied-by-opponent? move)
|
||||
(print "Choose an opponent's piece to remove."))
|
||||
)
|
||||
(and
|
||||
;; TODO: add flying phase
|
||||
(= stages.flying game.stage)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
; get player input
|
||||
(fn get-move []
|
||||
(print (.. "Player " game.player "'s turn:"))
|
||||
(io.read))
|
||||
|
||||
|
||||
(fn main []
|
||||
;; game loop
|
||||
(while (not (= game.stage stages.complete))
|
||||
(print-board board moves)
|
||||
(print-board const.board moves)
|
||||
|
||||
;; validation loop
|
||||
(var is-valid false)
|
||||
|
|
@ -268,14 +160,16 @@
|
|||
(while (not is-valid)
|
||||
(set move (get-move))
|
||||
(set is-valid (valid-move? move))
|
||||
(if (not is-valid)
|
||||
(print "Try again.")
|
||||
(do
|
||||
(print (.. "You chose " move))
|
||||
(tset moves (index-of-move move) game.player)
|
||||
(game:update move)
|
||||
(let [idx (index-of-move move)]
|
||||
(if (not is-valid)
|
||||
(print "Try again.")
|
||||
(do
|
||||
(print (.. "You chose " move))
|
||||
(tset moves idx game.player)
|
||||
(game:update idx)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue