diff options
| -rw-r--r-- | doc/README.md | 51 | ||||
| -rw-r--r-- | justfile | 7 | ||||
| -rw-r--r-- | lib/constants.fnl | 91 | ||||
| -rw-r--r-- | lib/contains.test.fnl | 28 | ||||
| -rw-r--r-- | lib/either.test.fnl | 81 | ||||
| -rw-r--r-- | lib/equal.fnl | 22 | ||||
| -rw-r--r-- | lib/equal.test.fnl | 28 | ||||
| -rw-r--r-- | lib/flip.fnl | 6 | ||||
| -rw-r--r-- | lib/flip.test.fnl | 13 | ||||
| -rw-r--r-- | lib/head.test.fnl | 23 | ||||
| -rw-r--r-- | lib/index.fnl | 26 | ||||
| -rw-r--r-- | lib/keys.fnl | 7 | ||||
| -rw-r--r-- | lib/keys.test.fnl | 13 | ||||
| -rw-r--r-- | lib/mill.fnl | 57 | ||||
| -rw-r--r-- | lib/mill.test.fnl | 142 | ||||
| -rw-r--r-- | lib/slice.fnl | 5 | ||||
| -rw-r--r-- | lib/slice.test.fnl | 19 | ||||
| -rw-r--r-- | lib/tail.test.fnl | 20 | ||||
| -rw-r--r-- | lib/test.fnl | 52 | ||||
| -rw-r--r-- | lib/test.test.fnl | 19 | ||||
| -rw-r--r-- | main.fnl | 236 |
21 files changed, 687 insertions, 259 deletions
diff --git a/doc/README.md b/doc/README.md new file mode 100644 index 0000000..0452038 --- /dev/null +++ b/doc/README.md @@ -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 + diff --git a/justfile b/justfile new file mode 100644 index 0000000..6fbee75 --- /dev/null +++ b/justfile @@ -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 diff --git a/lib/constants.fnl b/lib/constants.fnl new file mode 100644 index 0000000..c88b279 --- /dev/null +++ b/lib/constants.fnl @@ -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} + diff --git a/lib/contains.test.fnl b/lib/contains.test.fnl index 1c7fb06..45a00af 100644 --- a/lib/contains.test.fnl +++ b/lib/contains.test.fnl @@ -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)))) diff --git a/lib/either.test.fnl b/lib/either.test.fnl index fc819dc..8ae0c08 100644 --- a/lib/either.test.fnl +++ b/lib/either.test.fnl @@ -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)))) diff --git a/lib/equal.fnl b/lib/equal.fnl new file mode 100644 index 0000000..cc34ada --- /dev/null +++ b/lib/equal.fnl @@ -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} diff --git a/lib/equal.test.fnl b/lib/equal.test.fnl new file mode 100644 index 0000000..0ee8da7 --- /dev/null +++ b/lib/equal.test.fnl @@ -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)))) diff --git a/lib/flip.fnl b/lib/flip.fnl new file mode 100644 index 0000000..9d21b63 --- /dev/null +++ b/lib/flip.fnl @@ -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} + diff --git a/lib/flip.test.fnl b/lib/flip.test.fnl new file mode 100644 index 0000000..32fa005 --- /dev/null +++ b/lib/flip.test.fnl @@ -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))))) + + diff --git a/lib/head.test.fnl b/lib/head.test.fnl index 7514121..1209599 100644 --- a/lib/head.test.fnl +++ b/lib/head.test.fnl @@ -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)))) diff --git a/lib/index.fnl b/lib/index.fnl index 4d15b9a..7579a1d 100644 --- a/lib/index.fnl +++ b/lib/index.fnl @@ -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 } diff --git a/lib/keys.fnl b/lib/keys.fnl new file mode 100644 index 0000000..0f3364a --- /dev/null +++ b/lib/keys.fnl @@ -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} diff --git a/lib/keys.test.fnl b/lib/keys.test.fnl new file mode 100644 index 0000000..413a773 --- /dev/null +++ b/lib/keys.test.fnl @@ -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))))) + diff --git a/lib/mill.fnl b/lib/mill.fnl index de54128..e3b3337 100644 --- a/lib/mill.fnl +++ b/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 + } diff --git a/lib/mill.test.fnl b/lib/mill.test.fnl index 358b218..8bd3522 100644 --- a/lib/mill.test.fnl +++ b/lib/mill.test.fnl @@ -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)))) diff --git a/lib/slice.fnl b/lib/slice.fnl new file mode 100644 index 0000000..4f0de0f --- /dev/null +++ b/lib/slice.fnl @@ -0,0 +1,5 @@ +(fn slice [t start stop] + (fcollect [i start (or stop (length t))] + (. t i))) + +{: slice} diff --git a/lib/slice.test.fnl b/lib/slice.test.fnl new file mode 100644 index 0000000..9293f93 --- /dev/null +++ b/lib/slice.test.fnl @@ -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)))) + diff --git a/lib/tail.test.fnl b/lib/tail.test.fnl index 358b218..e507a0b 100644 --- a/lib/tail.test.fnl +++ b/lib/tail.test.fnl @@ -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)))) diff --git a/lib/test.fnl b/lib/test.fnl new file mode 100644 index 0000000..fbaaf8d --- /dev/null +++ b/lib/test.fnl @@ -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} diff --git a/lib/test.test.fnl b/lib/test.test.fnl new file mode 100644 index 0000000..7958141 --- /dev/null +++ b/lib/test.test.fnl @@ -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)))) diff --git a/main.fnl b/main.fnl index 169f4f9..d9ec3b4 100644 --- a/main.fnl +++ b/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) + ) ) - ) + ) ) ) ) |