summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/README.md51
-rw-r--r--justfile7
-rw-r--r--lib/constants.fnl91
-rw-r--r--lib/contains.test.fnl28
-rw-r--r--lib/either.test.fnl81
-rw-r--r--lib/equal.fnl22
-rw-r--r--lib/equal.test.fnl28
-rw-r--r--lib/flip.fnl6
-rw-r--r--lib/flip.test.fnl13
-rw-r--r--lib/head.test.fnl23
-rw-r--r--lib/index.fnl26
-rw-r--r--lib/keys.fnl7
-rw-r--r--lib/keys.test.fnl13
-rw-r--r--lib/mill.fnl57
-rw-r--r--lib/mill.test.fnl142
-rw-r--r--lib/slice.fnl5
-rw-r--r--lib/slice.test.fnl19
-rw-r--r--lib/tail.test.fnl20
-rw-r--r--lib/test.fnl52
-rw-r--r--lib/test.test.fnl19
-rw-r--r--main.fnl236
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)
+ )
)
- )
+ )
)
)
)
generated by cgit v1.2.3 (git 2.46.0) at 2025-08-21 18:21:34 +0000