diff options
| -rw-r--r-- | lib/contains.fnl | 7 | ||||
| -rw-r--r-- | lib/contains.test.fnl | 11 | ||||
| -rw-r--r-- | lib/either.fnl | 20 | ||||
| -rw-r--r-- | lib/either.test.fnl | 40 | ||||
| -rw-r--r-- | lib/head.fnl | 6 | ||||
| -rw-r--r-- | lib/head.test.fnl | 11 | ||||
| -rw-r--r-- | lib/index.fnl | 13 | ||||
| -rw-r--r-- | lib/mill.fnl | 16 | ||||
| -rw-r--r-- | lib/mill.test.fnl | 1 | ||||
| -rw-r--r-- | lib/tableprint.fnl | 7 | ||||
| -rw-r--r-- | lib/tail.fnl | 7 | ||||
| -rw-r--r-- | lib/tail.test.fnl | 1 | ||||
| -rw-r--r-- | main.fnl | 282 |
13 files changed, 422 insertions, 0 deletions
diff --git a/lib/contains.fnl b/lib/contains.fnl new file mode 100644 index 0000000..75275af --- /dev/null +++ b/lib/contains.fnl @@ -0,0 +1,7 @@ +(fn contains [t x] + (accumulate [found false + _ v (ipairs t) + &until found] ; escape early + (or found (= x v)))) + +{: contains} diff --git a/lib/contains.test.fnl b/lib/contains.test.fnl new file mode 100644 index 0000000..1c7fb06 --- /dev/null +++ b/lib/contains.test.fnl @@ -0,0 +1,11 @@ +(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)))) diff --git a/lib/either.fnl b/lib/either.fnl new file mode 100644 index 0000000..24aafca --- /dev/null +++ b/lib/either.fnl @@ -0,0 +1,20 @@ +(local Either {}) +(local Left {}) +(local Right {}) +(setmetatable Right Either) +(setmetatable Left Either) + +(fn Either.new [self x] + (local obj { :value (or x {}) }) + (tset self "__index" self) + (setmetatable obj self)) +(fn Either.of [x] (Right:new x)) + +(fn Right.map [self f] (Either.of (f self.value))) +(fn Left.map [self f] self) + +{ + : Either + : Left + : Right +} diff --git a/lib/either.test.fnl b/lib/either.test.fnl new file mode 100644 index 0000000..fc819dc --- /dev/null +++ b/lib/either.test.fnl @@ -0,0 +1,40 @@ +(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")) + + + +) diff --git a/lib/head.fnl b/lib/head.fnl new file mode 100644 index 0000000..ddee698 --- /dev/null +++ b/lib/head.fnl @@ -0,0 +1,6 @@ +; return the first item in a table +(fn head [t] (if (> (length t) 0) + (?. t 1) + [])) + +{: head} diff --git a/lib/head.test.fnl b/lib/head.test.fnl new file mode 100644 index 0000000..7514121 --- /dev/null +++ b/lib/head.test.fnl @@ -0,0 +1,11 @@ +(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)))) diff --git a/lib/index.fnl b/lib/index.fnl new file mode 100644 index 0000000..4d15b9a --- /dev/null +++ b/lib/index.fnl @@ -0,0 +1,13 @@ +(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)) + +{ + :contains contains + :head head + :mill? mill? + :pprint pprint + :tail tail + } diff --git a/lib/mill.fnl b/lib/mill.fnl new file mode 100644 index 0000000..de54128 --- /dev/null +++ b/lib/mill.fnl @@ -0,0 +1,16 @@ +(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?} diff --git a/lib/mill.test.fnl b/lib/mill.test.fnl new file mode 100644 index 0000000..358b218 --- /dev/null +++ b/lib/mill.test.fnl @@ -0,0 +1 @@ +;; TODO: test me diff --git a/lib/tableprint.fnl b/lib/tableprint.fnl new file mode 100644 index 0000000..4d9bfbe --- /dev/null +++ b/lib/tableprint.fnl @@ -0,0 +1,7 @@ +; print a table +(fn pprint [tbl] + (each [k v (pairs tbl)] + (let [table? (= (type v) :table)] + (print k v)))) + +{: pprint} diff --git a/lib/tail.fnl b/lib/tail.fnl new file mode 100644 index 0000000..24de254 --- /dev/null +++ b/lib/tail.fnl @@ -0,0 +1,7 @@ +; return the table minus the head +(fn tail [t] + (icollect [i v (ipairs t)] + (if (> i 1) + v))) + +{: tail} diff --git a/lib/tail.test.fnl b/lib/tail.test.fnl new file mode 100644 index 0000000..358b218 --- /dev/null +++ b/lib/tail.test.fnl @@ -0,0 +1 @@ +;; TODO: test me diff --git a/main.fnl b/main.fnl new file mode 100644 index 0000000..169f4f9 --- /dev/null +++ b/main.fnl @@ -0,0 +1,282 @@ +; 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 + :mill? mill-maker + :pprint pprint + } (require :lib.index)) + + +; there are three phases of play: +; placing, moving, and flying. +; (plus one for capturing) +; (plus one for complete) +(local stages { + :placing 1 + :moving 2 + :flying 3 + :capture 4 + :complete 5 +}) + + +; there are two players +; their names are LUIGI and MARIO +(local player { + :one 1 ;; luigi + :two 2 ;; mario +}) + + +; initialize moves[] to 0. +; this is the game state. +; shows which spaces are occupied by which players. +; 0 = unoccupied +; 1 = Player 1 +; 2 = Player 2 +(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) + (do + (print "MILLLLLLLLLLLLL!") + (tset self :stage stages.capture) + ) + (tset self :player (if (= player.one self.player) player.two player.one)) + ) + ) +}) + + + + + +; 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! +(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 + (each [_ row (ipairs board)] + (let [(template count) (string.gsub row "x" "%%d")] + (if (> count 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 + + +; 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))] + (each [_ v (ipairs reversed)] + (table.insert valid-spaces v)))) +(add-reverse-moves) + + +; does the move exist within the domain of valid spaces +(fn space-exists? [m] (contains valid-spaces (string.upper m))) + +; return the numerical index of a "A1" 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))) + ] + idx)) + +; is the space represented by a move ("A1") unoccupied? +(fn space-is-unoccupied? [m] + (let [unoccupied? 0] + (= unoccupied? (. 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 +; https://mostly-adequate.gitbook.io/mostly-adequate-guide/appendix_b#either +; or maybe all i need is a case-try statement.. +; https://fennel-lang.org/reference#case-try-for-matching-multiple-steps +; update: i didn't really like that +; i think maybe i do want the monad after all.. +; i'll come back to it later +(fn valid-move? [move] + (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!")))) + (and + ;; TODO: add capturing phase + (= stages.capturing game.stage) + ) + (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) + + ;; validation loop + (var is-valid false) + (var move "") + (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) + ) + ) + ) + ) +) +(main) |