From c7b2c982004e350f5e3032321baadfc9021b6bad Mon Sep 17 00:00:00 2001 From: dozens Date: Thu, 20 Jun 2024 09:17:06 -0600 Subject: 🗄️ big tidy up - isolate core game logic and move it to src/game.fnl - main.fnl should be just the ui now - move all table funcs into lib/table - move all (1) string funcs into lib/string - move all game funcs into lib/game/ --- doc/tilde30.t | 27 ++++- justfile | 9 +- lib/all-mills.fnl | 25 ---- lib/all-mills.test.fnl | 41 ------- lib/constants.fnl | 14 +++ lib/contains.fnl | 7 -- lib/contains.test.fnl | 17 --- lib/either.test.fnl | 72 ++++++------ lib/equal.fnl | 22 ---- lib/equal.test.fnl | 28 ----- lib/game/README | 5 + lib/game/all-mills.fnl | 25 ++++ lib/game/all-mills.test.fnl | 41 +++++++ lib/game/index.fnl | 11 ++ lib/game/mill.fnl | 41 +++++++ lib/game/mill.test.fnl | 123 ++++++++++++++++++++ lib/game/no-moves.fnl | 26 +++++ lib/game/no-moves.test.fnl | 49 ++++++++ lib/game/space-is-neighbor.fnl | 19 ++++ lib/game/space-is-neighbor.test.fnl | 20 ++++ lib/head.fnl | 6 - lib/head.test.fnl | 12 -- lib/index.fnl | 8 -- lib/keys.fnl | 7 -- lib/keys.test.fnl | 13 --- lib/kvflip.fnl | 6 - lib/kvflip.test.fnl | 13 --- lib/mill.fnl | 41 ------- lib/mill.test.fnl | 150 ------------------------ lib/no-moves.fnl | 26 ----- lib/no-moves.test.fnl | 51 --------- lib/slice.fnl | 5 - lib/slice.test.fnl | 19 ---- lib/space-is-neighbor.fnl | 18 --- lib/space-is-neighbor.test.fnl | 22 ---- lib/string.fnl | 2 + lib/string.test.fnl | 13 +++ lib/table.fnl | 50 ++++++-- lib/table.test.fnl | 80 +++++++++++++ lib/tableprint.fnl | 7 -- lib/tail.fnl | 7 -- lib/tail.test.fnl | 19 ---- lib/test.fnl | 42 +++++-- lib/test.test.fnl | 70 +++++++++--- main.fnl | 221 +----------------------------------- src/game.fnl | 204 +++++++++++++++++++++++++++++++++ 46 files changed, 869 insertions(+), 865 deletions(-) delete mode 100644 lib/all-mills.fnl delete mode 100644 lib/all-mills.test.fnl delete mode 100644 lib/contains.fnl delete mode 100644 lib/contains.test.fnl delete mode 100644 lib/equal.fnl delete mode 100644 lib/equal.test.fnl create mode 100644 lib/game/README create mode 100644 lib/game/all-mills.fnl create mode 100644 lib/game/all-mills.test.fnl create mode 100644 lib/game/index.fnl create mode 100644 lib/game/mill.fnl create mode 100644 lib/game/mill.test.fnl create mode 100644 lib/game/no-moves.fnl create mode 100644 lib/game/no-moves.test.fnl create mode 100644 lib/game/space-is-neighbor.fnl create mode 100644 lib/game/space-is-neighbor.test.fnl delete mode 100644 lib/head.fnl delete mode 100644 lib/head.test.fnl delete mode 100644 lib/keys.fnl delete mode 100644 lib/keys.test.fnl delete mode 100644 lib/kvflip.fnl delete mode 100644 lib/kvflip.test.fnl delete mode 100644 lib/mill.fnl delete mode 100644 lib/mill.test.fnl delete mode 100644 lib/no-moves.fnl delete mode 100644 lib/no-moves.test.fnl delete mode 100644 lib/slice.fnl delete mode 100644 lib/slice.test.fnl delete mode 100644 lib/space-is-neighbor.fnl delete mode 100644 lib/space-is-neighbor.test.fnl create mode 100644 lib/string.test.fnl create mode 100644 lib/table.test.fnl delete mode 100644 lib/tableprint.fnl delete mode 100644 lib/tail.fnl delete mode 100644 lib/tail.test.fnl create mode 100644 src/game.fnl diff --git a/doc/tilde30.t b/doc/tilde30.t index a2dfb9f..c931c07 100644 --- a/doc/tilde30.t +++ b/doc/tilde30.t @@ -246,6 +246,31 @@ I've never used it before. It's basically the "compose" or "pipe" function that I have enjoyed using before in javascript. up next: fix that bug! - +. +. +.IP 18 +Finished the game today! +(I think!) +Working on modularizing the core logic +and tidying up some of the libraries. +Up next: Story Mode. +. +. +.IP 19 +Just did a bunch of tidying up. +Consolodated some libs. +(All table funs into a 'table' modules, e.g.) +Rewrote a couple of functions. +Sometimes using the threading macros +can replace a 'let' block +with a tighter pointfree composition +that I sometimes like. +My surgery is tomorrow. +After that I am going to be in a lot of pain / +on a lot of drugs, +and will be spending a lot of time on my back. +So I'm either going to get a lot on 9mm, +or nothing at all. +We'll see! .pl \n[nl]u diff --git a/justfile b/justfile index 4827cef..825aa93 100644 --- a/justfile +++ b/justfile @@ -4,7 +4,8 @@ default: # run tests test: - for f in lib/*.test.fnl; do fennel $f | faucet; done + #!/bin/zsh + for f in **/*.test.fnl; do fennel $f | faucet; done # build expect scripts expects: @@ -12,4 +13,8 @@ expects: # make the project project: - awk '$0 ~ /^---$/ && times++ < 2 { a=!a;next; } a' doc/tilde30.t | recfmt -f doc/tilde30.t | awk '$0 ~ /^---$/ { times++;next } times > 1' | nroff -ms -Tascii + awk '$0 ~ /^---$/ && times++ < 2 { a=!a;next; } a' doc/tilde30.t \ + | recfmt -f doc/tilde30.t \ + | awk '$0 ~ /^---$/ { times++;next } times > 1' \ + | nroff -ms -Tascii \ + | ssh tilde 'cat > .project' diff --git a/lib/all-mills.fnl b/lib/all-mills.fnl deleted file mode 100644 index 562bb97..0000000 --- a/lib/all-mills.fnl +++ /dev/null @@ -1,25 +0,0 @@ -(local {: mill-at? } (require :lib.mill)) -(local {: mills } (require :lib.constants)) - -(fn toggle-player [p] (if (= p 1) 2 1)) - -(fn only-player-moves [moves player] - (icollect [_ move (ipairs moves)] (if (= move player) player 0))) - -(fn all-moves-are-mills? [moves player] - (accumulate [result true - i m (ipairs moves) ] - (and result (if (= m 0) true (mill-at? mills moves i))))) - -(fn all-mills? [all-moves current-player] - (let [next-player (toggle-player current-player) - player-moves (only-player-moves all-moves next-player) - all-mills (all-moves-are-mills? player-moves current-player)] - all-mills)) - -{: all-mills? - ;; do not use; just for testing: - : toggle-player - : only-player-moves - : all-moves-are-mills? - } diff --git a/lib/all-mills.test.fnl b/lib/all-mills.test.fnl deleted file mode 100644 index 7f33ab1..0000000 --- a/lib/all-mills.test.fnl +++ /dev/null @@ -1,41 +0,0 @@ -(let [{: describe - :end test-end} (require :lib.test) - {: all-mills? - : toggle-player - : only-player-moves - : all-moves-are-mills? - } (require :lib.all-mills)] - - (describe "all-mills" (fn [] - (describe "#toggle-player()" (fn [t] - (t {:given "a player" - :should "return the next" - :expected 2 - :actual (toggle-player 1) - }))) - (describe "#only-player-moves()" (fn [t] - (let [moves [ 0 2 0 2 2 2 0 0 0 0 0 0 0 2 0 0 0 2 0 2 0 1 1 1 ] - expected [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] - ] - (t {:given "a bunch of moves and a player" - :should "filter out all the moves not belonging to the player" - : expected - :actual (only-player-moves moves 1) - })))) - (describe "#all-moves-are-mills?()" (fn [t] - (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] - ] - (t {:given "a bunch of moves and a player" - :should "return true if all the player moves are mills" - :expected true - :actual (all-moves-are-mills? moves 1) - })) - (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 ] - ] - (t {:given "a bunch of moves and no mill and a player" - :should "return false" - :expected false - :actual (all-moves-are-mills? moves 1) - })))) - (test-end)))) - diff --git a/lib/constants.fnl b/lib/constants.fnl index c88b279..be9a6be 100644 --- a/lib/constants.fnl +++ b/lib/constants.fnl @@ -84,8 +84,22 @@ "G x-----x-----x" ;; 22 23 24 ]) + +;; there are three phases of play: +;; placing, moving, and flying. +;; (plus one for capturing) +;; (plus one for game-over) +(local stages { + :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! jk the cows are fine. the game's just over okay +}) + {: board : mills : neighbors + : stages : spaces} diff --git a/lib/contains.fnl b/lib/contains.fnl deleted file mode 100644 index 75275af..0000000 --- a/lib/contains.fnl +++ /dev/null @@ -1,7 +0,0 @@ -(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 deleted file mode 100644 index 45a00af..0000000 --- a/lib/contains.test.fnl +++ /dev/null @@ -1,17 +0,0 @@ -(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 8ae0c08..5a29ea7 100644 --- a/lib/either.test.fnl +++ b/lib/either.test.fnl @@ -1,41 +1,33 @@ -(let [{: pprint} (require :lib.tableprint) - {: describe :end test-end} (require :lib.test) +(let [{:print pprint} (require :lib.table) + {: describe : 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)))) + (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 deleted file mode 100644 index cc34ada..0000000 --- a/lib/equal.fnl +++ /dev/null @@ -1,22 +0,0 @@ -;; 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 deleted file mode 100644 index 0ee8da7..0000000 --- a/lib/equal.test.fnl +++ /dev/null @@ -1,28 +0,0 @@ -(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/game/README b/lib/game/README new file mode 100644 index 0000000..6dcd00f --- /dev/null +++ b/lib/game/README @@ -0,0 +1,5 @@ +These are all game specific functions that are big and or complex enough that i +wanted to break them out into their own modules so i could test them. + +when you add a function here, add a test file, and be sure to import/export it +to/from index.fnl diff --git a/lib/game/all-mills.fnl b/lib/game/all-mills.fnl new file mode 100644 index 0000000..e5b3d2b --- /dev/null +++ b/lib/game/all-mills.fnl @@ -0,0 +1,25 @@ +(local {: mill-at? } (require :lib.game.mill)) +(local {: mills } (require :lib.constants)) + +(fn toggle-player [p] (if (= p 1) 2 1)) + +(fn only-player-moves [moves player] + (icollect [_ move (ipairs moves)] (if (= move player) player 0))) + +(fn all-moves-are-mills? [player moves] + (accumulate [result true + i m (ipairs moves) ] + (and result (if (= m 0) true (mill-at? mills moves i))))) + +(fn all-mills? [all-moves current-player] + (->> current-player + (toggle-player) + (only-player-moves all-moves) + (all-moves-are-mills? current-player))) + +{: all-mills? + ;; do not use; just for testing: + : toggle-player + : only-player-moves + : all-moves-are-mills? + } diff --git a/lib/game/all-mills.test.fnl b/lib/game/all-mills.test.fnl new file mode 100644 index 0000000..055f6a5 --- /dev/null +++ b/lib/game/all-mills.test.fnl @@ -0,0 +1,41 @@ +(let [{: describe + : test-end} (require :lib.test) + {: all-mills? + : toggle-player + : only-player-moves + : all-moves-are-mills? + } (require :lib.game.all-mills)] + + (describe "# ALL-MILLS" (fn [] + (describe "toggle-player()" (fn [t] + (t {:given "a player" + :should "return the next" + :expected 2 + :actual (toggle-player 1) + }))) + (describe "only-player-moves()" (fn [t] + (let [moves [ 0 2 0 2 2 2 0 0 0 0 0 0 0 2 0 0 0 2 0 2 0 1 1 1 ] + expected [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] + ] + (t {:given "a bunch of moves and a player" + :should "filter out all the moves not belonging to the player" + : expected + :actual (only-player-moves moves 1) + })))) + (describe "all-moves-are-mills?()" (fn [t] + (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] + ] + (t {:given "a bunch of moves and a player" + :should "return true if all the player moves are mills" + :expected true + :actual (all-moves-are-mills? 1 moves) + })) + (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 ] + ] + (t {:given "a bunch of moves and no mill and a player" + :should "return false" + :expected false + :actual (all-moves-are-mills? 1 moves) + })))) + (test-end)))) + diff --git a/lib/game/index.fnl b/lib/game/index.fnl new file mode 100644 index 0000000..f542f76 --- /dev/null +++ b/lib/game/index.fnl @@ -0,0 +1,11 @@ +(local {: all-mills?} (require :lib.game.all-mills)) +(local {: mill-at?} (require :lib.game.mill)) +(local {: space-is-neighbor?} (require :lib.game.space-is-neighbor)) +(local {: no-moves?} (require :lib.game.no-moves)) + +{ + : all-mills? + : mill-at? + : no-moves? + : space-is-neighbor? + } diff --git a/lib/game/mill.fnl b/lib/game/mill.fnl new file mode 100644 index 0000000..d15b53e --- /dev/null +++ b/lib/game/mill.fnl @@ -0,0 +1,41 @@ +(local {: contains} (require :lib.table)) + +(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 any [t] + "take a list of booleans, returns true if any of them are true" + (accumulate [acc false + i x (ipairs t)] + (or acc x))) + +(fn move-mills [moves-list] + (icollect [_ moves (ipairs moves-list)] + (let [player (. moves 1)] + (accumulate [acc true + _ m (ipairs moves)] + (and acc (not= m 0) (= player m)))))) + +(fn candidate-moves [moves candidates] + "Just turning board spaces into player moves" + (icollect [_ spaces (ipairs candidates)] + (icollect [_ space (ipairs spaces)] + (. moves space)))) + +(fn mill-at? [all-mills current-moves move] + "Is there a mill at this move?" + (->> (get-candidates all-mills move) + (candidate-moves current-moves) + (move-mills) + (any))) + +{: mill-at? + ;; not for consumption, + ;; just for testing: + : get-candidates + : candidate-moves + : move-mills + : any + } diff --git a/lib/game/mill.test.fnl b/lib/game/mill.test.fnl new file mode 100644 index 0000000..604c759 --- /dev/null +++ b/lib/game/mill.test.fnl @@ -0,0 +1,123 @@ +(let [{: describe + : test-end} (require :lib.test) + {: mill-at? + : get-candidates + : move-mills + : candidate-moves + : any + } (require :lib.game.mill) + {: mills } (require :lib.constants) + with-mills (partial mill-at? 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) })) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + expected [[1 2 3] [1 10 22]] + ] + {:given (string.format "a move of %d" move) + :should "still return [[1 2 3] [1 10 22]]" + : expected + :actual (get-candidates mills move) })))) + + (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 "move-mills()" (fn [t] + (t + (let [moves [[1 1 1] [0 2 2]] ] + {:given "a list of moves" + :should "turn them into true/false if they are mills" + :expected [true false] + :actual (move-mills moves) })) + (t + (let [moves [[0 1 1] [0 2 2]] ] + {:given "no mills" + :should "should return false" + :expected [false false] + :actual (move-mills moves) })) + (t + (let [moves [[2 2 2] [2 0 0]] ] + {:given "mill, no mill" + :should "should return true false" + :expected [true false] + :actual (move-mills moves) })))) + + (describe "candidate-moves()" (fn [t] + (t (let [spaces [[1 2 3] [1 10 22]] + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ] + {:given "spaces [[1 2 3] [1 10 22]]" + :should "map to moves" + :expected [[2 2 2] [2 0 0]] + :actual (candidate-moves moves spaces)})))) + + (describe "mill-at?()" (fn [t] + (t + (let [move 1 + moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ] + {:given "no mills" + :should "return false" + :expected false + :actual (mill-at? mills moves move)})) + (t + (let [move 4 + moves [1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill but not at Move" + :should "return false" + :expected false + :actual (with-moves move)})) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill" + :should "return true" + :expected true + :actual (with-moves move) })) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill" + :should "return the opposite of false" + :expected false + :actual (not (with-moves move)) })))) + + (test-end)))) diff --git a/lib/game/no-moves.fnl b/lib/game/no-moves.fnl new file mode 100644 index 0000000..02482cc --- /dev/null +++ b/lib/game/no-moves.fnl @@ -0,0 +1,26 @@ +(local {: tail} (require :lib.table)) + +(fn get-player-idxs [player moves] + (icollect [i p (ipairs moves)] (when (= p player) i))) + +(fn idx-to-neighbors [idxs all-neighbors] + (icollect [_ i (ipairs idxs)] (tail (. all-neighbors i)))) + +(fn neighbor-is-occupied? [neighbors moves] + (icollect [_ move (ipairs neighbors)] + (icollect [_ neighbor (ipairs move)] + (not= (. moves neighbor) 0)))) + +(fn reduce-to-bool [xs] + (accumulate [acc true + _ x (ipairs xs)] + (and x))) + +(fn no-moves? [neighbors all-moves player] + (-> (get-player-idxs player all-moves) + (idx-to-neighbors neighbors) + (neighbor-is-occupied? all-moves) + (reduce-to-bool) + (reduce-to-bool))) + +{: no-moves? } diff --git a/lib/game/no-moves.test.fnl b/lib/game/no-moves.test.fnl new file mode 100644 index 0000000..a94d60a --- /dev/null +++ b/lib/game/no-moves.test.fnl @@ -0,0 +1,49 @@ +(let [{: no-moves?} (require :lib.game.no-moves) + {: neighbors} (require :lib.constants) + {: describe : test-end} (require :lib.test) + with-neighbors (partial no-moves? neighbors) + ] + + (describe "# NOMOVES" (fn [t] + (let [moves [ 1 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "one move with no moves" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "one move with one move" + :should "return false" + :expected false + :actual (with-neighbors moves player) + })) + (let [moves [ 1 1 1 0 2 0 0 0 0 2 0 0 0 0 2 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "several moves with no moves" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 0 2 0 2 1 2 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "four occupied neighbors" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 1 2 1 2 0 2 1 2 1 2 1 0 1 2 1 2 2 2 0 1 0 0 0 0 0 ] + player 2 + ] + (t {:given "this turn that is giving me trouble" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + + (test-end)))) diff --git a/lib/game/space-is-neighbor.fnl b/lib/game/space-is-neighbor.fnl new file mode 100644 index 0000000..373feaf --- /dev/null +++ b/lib/game/space-is-neighbor.fnl @@ -0,0 +1,19 @@ +(local {: contains + : head + : tail + } (require :lib.table)) + +(lambda space-is-neighbor? [all-neighbors from to] + ;; i have learned to check that i'm passing the correct type of move + ;; i.e. a number and not a string + (assert (= "number" (type from)) "from must be a number") + (assert (= "number" (type to)) "to must be a number") + (assert (= "table" (type all-neighbors)) "all-neighbors must be a table") + + (let [neighborhood-list (icollect [_ n (ipairs all-neighbors)] (if (= from (head n)) n)) + neighborhood (head neighborhood-list) + neighbors (tail neighborhood) + is-neighbor (contains neighbors to)] + is-neighbor)) + +{: space-is-neighbor?} diff --git a/lib/game/space-is-neighbor.test.fnl b/lib/game/space-is-neighbor.test.fnl new file mode 100644 index 0000000..0ae7d4e --- /dev/null +++ b/lib/game/space-is-neighbor.test.fnl @@ -0,0 +1,20 @@ +(let [{: space-is-neighbor?} (require :lib.game.space-is-neighbor) + {: neighbors} (require :lib.constants) + {: describe : test-end} (require :lib.test) + with-neighbors (partial space-is-neighbor? neighbors) ] + + (describe "# SPACE-IS-NEIGHBOR" (fn [t] + (t {:given "space of 3" + :should "know 2 is a neighbor" + :expected true + :actual (with-neighbors 3 2)}) + (t {:given "space of 3" + :should "know 15 is a neighbor" + :expected true + :actual (with-neighbors 3 15)}) + (t {:given "space of 3" + :should "know 1 is not a neighbor" + :expected false + :actual (with-neighbors 3 1)}) + + (test-end)))) diff --git a/lib/head.fnl b/lib/head.fnl deleted file mode 100644 index ddee698..0000000 --- a/lib/head.fnl +++ /dev/null @@ -1,6 +0,0 @@ -; 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 deleted file mode 100644 index 1209599..0000000 --- a/lib/head.test.fnl +++ /dev/null @@ -1,12 +0,0 @@ -(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 2eff31e..1b4b728 100644 --- a/lib/index.fnl +++ b/lib/index.fnl @@ -1,15 +1,7 @@ (local str (require :lib.string)) (local tbl (require :lib.table)) -(local {: all-mills?} (require :lib.all-mills)) -(local {: mill-at?} (require :lib.mill)) -(local {: space-is-neighbor?} (require :lib.space-is-neighbor)) -(local {: no-moves?} (require :lib.no-moves)) { : str : tbl - : all-mills? - : mill-at? - : no-moves? - : space-is-neighbor? } diff --git a/lib/keys.fnl b/lib/keys.fnl deleted file mode 100644 index 0f3364a..0000000 --- a/lib/keys.fnl +++ /dev/null @@ -1,7 +0,0 @@ -(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 deleted file mode 100644 index 413a773..0000000 --- a/lib/keys.test.fnl +++ /dev/null @@ -1,13 +0,0 @@ -(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/kvflip.fnl b/lib/kvflip.fnl deleted file mode 100644 index 25fc222..0000000 --- a/lib/kvflip.fnl +++ /dev/null @@ -1,6 +0,0 @@ -(fn kvflip [t] - "takes a table of {key value} and returns a table of {value key}" - (collect [k v (pairs t)] (values v k))) - -{: kvflip} - diff --git a/lib/kvflip.test.fnl b/lib/kvflip.test.fnl deleted file mode 100644 index 162650d..0000000 --- a/lib/kvflip.test.fnl +++ /dev/null @@ -1,13 +0,0 @@ -(let [{: kvflip} (require :lib.kvflip) - {: describe :end test-end} (require :lib.test)] - (describe "kvflip()" (fn [t] - (let [input {:apple "red" :banana "yellow"} - expected {:red "apple" :yellow "banana"} - ] - (t {:given "a table" - :should "kvflip that table!" - : expected - :actual (kvflip input)}) - (test-end))))) - - diff --git a/lib/mill.fnl b/lib/mill.fnl deleted file mode 100644 index f9c8673..0000000 --- a/lib/mill.fnl +++ /dev/null @@ -1,41 +0,0 @@ -(local {: contains} (require :lib.contains)) - -(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 any [t] - "take a list of booleans, returns true if any of them are true" - (accumulate [acc false - i x (ipairs t)] - (or acc x))) - -(fn move-mills [moves-list] - (icollect [_ moves (ipairs moves-list)] - (let [player (. moves 1)] - (accumulate [acc true - _ m (ipairs moves)] - (and acc (not= m 0) (= player m)))))) - -(fn candidate-moves [candidates moves] - "Just turning board spaces into player moves" - (icollect [_ spaces (ipairs candidates)] - (icollect [_ space (ipairs spaces)] - (. moves space)))) - -(fn mill-at? [all-mills current-moves move] - "Is there a mill at this move?" - (let [candidates (get-candidates all-mills move) - my-moves (candidate-moves candidates current-moves) - my-mills (move-mills my-moves) - result (any my-mills)] - result)) - -{: mill-at? - ;; not for consumption, - ;; just for testing: - : get-candidates - : candidate-moves - : move-mills - : any - } diff --git a/lib/mill.test.fnl b/lib/mill.test.fnl deleted file mode 100644 index 04f7e97..0000000 --- a/lib/mill.test.fnl +++ /dev/null @@ -1,150 +0,0 @@ -(let [{: describe - :end test-end} (require :lib.test) - {: mill-at? - : get-candidates - : move-mills - : candidate-moves - : any - } (require :lib.mill) - {: mills } (require :lib.constants) - with-mills (partial mill-at? 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) - })) - (t - (let [move 1 - moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - expected [[1 2 3] [1 10 22]] - ] - {:given (string.format "a move of %d" move) - :should "still return [[1 2 3] [1 10 22]]" - : expected - :actual (get-candidates mills move) - })) - )) - - (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 "#move-mills()" (fn [t] - (t - (let [moves [[1 1 1] [0 2 2]] - ] - {:given "a list of moves" - :should "turn them into true/false if they are mills" - :expected [true false] - :actual (move-mills moves) - })) - (t - (let [moves [[0 1 1] [0 2 2]] - ] - {:given "no mills" - :should "should return false" - :expected [false false] - :actual (move-mills moves) - })) - (t - (let [moves [[2 2 2] [2 0 0]] - ] - {:given "mill, no mill" - :should "should return true false" - :expected [true false] - :actual (move-mills moves) - })) - )) - - (describe "#candidate-moves()" (fn [t] - (t (let [spaces [[1 2 3] [1 10 22]] - moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - ] - {:given "spaces [[1 2 3] [1 10 22]]" - :should "map to moves" - :expected [[2 2 2] [2 0 0]] - :actual (candidate-moves spaces moves) - } - ) - ) - )) - - (describe "#mill-at?()" (fn [t] - (t - (let [move 1 - moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - ] - {:given "no mills" - :should "return false" - :expected false - :actual (mill-at? mills moves move) - })) - (t - (let [move 4 - moves [1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - with-mills (partial mill-at? mills) - with-moves (partial with-mills moves)] - {:given "a mill but not at Move" - :should "return false" - :expected false - :actual (with-moves move) - })) - (t - (let [move 1 - moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - with-mills (partial mill-at? mills) - with-moves (partial with-mills moves)] - {:given "a mill" - :should "return true" - :expected true - :actual (with-moves move) - })) - (t - (let [move 1 - moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - with-mills (partial mill-at? mills) - with-moves (partial with-mills moves)] - {:given "a mill" - :should "return the opposite of false" - :expected false - :actual (not (with-moves move)) - })) - )) - - (test-end)))) diff --git a/lib/no-moves.fnl b/lib/no-moves.fnl deleted file mode 100644 index 591cb7c..0000000 --- a/lib/no-moves.fnl +++ /dev/null @@ -1,26 +0,0 @@ -(local {: tail} (require :lib.tail)) - -(fn get-player-idxs [player moves] - (icollect [i p (ipairs moves)] (when (= p player) i))) - -(fn idx-to-neighbors [idxs all-neighbors] - (icollect [_ i (ipairs idxs)] (tail (. all-neighbors i)))) - -(fn neighbor-is-occupied? [neighbors moves] - (icollect [_ move (ipairs neighbors)] - (icollect [_ neighbor (ipairs move)] - (not= (. moves neighbor) 0)))) - -(fn reduce-to-bool [xs] - (accumulate [acc true - _ x (ipairs xs)] - (and x))) - -(fn no-moves? [neighbors all-moves player] - (-> (get-player-idxs player all-moves) - (idx-to-neighbors neighbors) - (neighbor-is-occupied? all-moves) - (reduce-to-bool) - (reduce-to-bool))) - -{: no-moves? } diff --git a/lib/no-moves.test.fnl b/lib/no-moves.test.fnl deleted file mode 100644 index db0613c..0000000 --- a/lib/no-moves.test.fnl +++ /dev/null @@ -1,51 +0,0 @@ -(let [{: no-moves?} (require :lib.no-moves) - {: neighbors} (require :lib.constants) - {: describe :end test-end} (require :lib.test) - with-neighbors (partial no-moves? neighbors) - ] - - (describe "no-moves()" (fn [t] - (let [moves [ 1 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 ] - player 1 - ] - (t {:given "one move with no moves" - :should "return true" - :expected true - :actual (with-neighbors moves player) - })) - (let [moves [ 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] - player 1 - ] - (t {:given "one move with one move" - :should "return false" - :expected false - :actual (with-neighbors moves player) - })) - (let [moves [ 1 1 1 0 2 0 0 0 0 2 0 0 0 0 2 0 0 0 0 0 0 0 ] - player 1 - ] - (t {:given "several moves with no moves" - :should "return true" - :expected true - :actual (with-neighbors moves player) - })) - (let [moves [ 0 2 0 2 1 2 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] - player 1 - ] - (t {:given "four occupied neighbors" - :should "return true" - :expected true - :actual (with-neighbors moves player) - })) - (let [moves [ 1 2 1 2 0 2 1 2 1 2 1 0 1 2 1 2 2 2 0 1 0 0 0 0 0 ] - player 2 - ] - (t {:given "this turn that is giving me trouble" - :should "return true" - :expected true - :actual (with-neighbors moves player) - })) - - (test-end)))) - - diff --git a/lib/slice.fnl b/lib/slice.fnl deleted file mode 100644 index 4f0de0f..0000000 --- a/lib/slice.fnl +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index 9293f93..0000000 --- a/lib/slice.test.fnl +++ /dev/null @@ -1,19 +0,0 @@ -(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/space-is-neighbor.fnl b/lib/space-is-neighbor.fnl deleted file mode 100644 index 380607c..0000000 --- a/lib/space-is-neighbor.fnl +++ /dev/null @@ -1,18 +0,0 @@ -(local {: contains} (require :lib.contains)) -(local {: head} (require :lib.head)) -(local {: tail} (require :lib.tail)) - -(lambda space-is-neighbor? [all-neighbors from to] - ;; i have learned to check that i'm passing the correct type of move - ;; i.e. a number and not a string - (assert (= "number" (type from)) "from must be a number") - (assert (= "number" (type to)) "to must be a number") - (assert (= "table" (type all-neighbors)) "all-neighbors must be a table") - - (let [neighborhood-list (icollect [_ n (ipairs all-neighbors)] (if (= from (head n)) n)) - neighborhood (head neighborhood-list) - neighbors (tail neighborhood) - is-neighbor (contains neighbors to)] - is-neighbor)) - -{: space-is-neighbor?} diff --git a/lib/space-is-neighbor.test.fnl b/lib/space-is-neighbor.test.fnl deleted file mode 100644 index 7b0c0af..0000000 --- a/lib/space-is-neighbor.test.fnl +++ /dev/null @@ -1,22 +0,0 @@ -(let [{: space-is-neighbor?} (require :lib.space-is-neighbor) - {: neighbors} (require :lib.constants) - {: describe :end test-end} (require :lib.test) - with-neighbors (partial space-is-neighbor? neighbors) - ] - - (describe "space-is-neighbor()" (fn [t] - (t {:given "space of 3" - :should "know 2 is a neighbor" - :expected true - :actual (with-neighbors 3 2)}) - (t {:given "space of 3" - :should "know 15 is a neighbor" - :expected true - :actual (with-neighbors 3 15)}) - (t {:given "space of 3" - :should "know 1 is not a neighbor" - :expected false - :actual (with-neighbors 3 1)}) - - (test-end)))) - diff --git a/lib/string.fnl b/lib/string.fnl index 510b0ed..28d1866 100644 --- a/lib/string.fnl +++ b/lib/string.fnl @@ -1,3 +1,5 @@ +;; string funs + (fn capitalize [s] (.. (string.upper (string.sub s 1 1)) (string.sub s 2))) diff --git a/lib/string.test.fnl b/lib/string.test.fnl new file mode 100644 index 0000000..1f9bdbd --- /dev/null +++ b/lib/string.test.fnl @@ -0,0 +1,13 @@ +(let [{: capitalize + } (require :lib.string) + {: describe + : test-end} (require :lib.test)] + +(describe "# STRING" (fn [] + (describe "capitalize()" (fn [t] + (t {:given "a string" + :should "capitalize it" + :expected :Giraffe + :actual (capitalize :giraffe)}))) + (test-end)))) + diff --git a/lib/table.fnl b/lib/table.fnl index f40c299..276e12d 100644 --- a/lib/table.fnl +++ b/lib/table.fnl @@ -1,16 +1,50 @@ -(local {: contains} (require :lib.contains)) -(local {: head} (require :lib.head)) -(local {: keys} (require :lib.keys)) -(local {:kvflip invert} (require :lib.kvflip)) -(local {:pprint print} (require :lib.tableprint)) -(local {: slice} (require :lib.slice)) -(local {: tail} (require :lib.tail)) +;; table funs + +(fn contains [t x] + "does table t contain element x?" + (accumulate [found false + _ v (ipairs t) + &until found] ; escape early + (or found (= x v)))) + +(fn head [t] + "return the first item in a table" + (if (> (length t) 0) + (?. t 1) + [])) + +(fn tail [t] + "return the table minus the head" + (icollect [i v (ipairs t)] + (if (> i 1) + v))) + +(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) + +(fn flip [t] + "takes a table of {key value} and returns a table of {value key}" + (collect [k v (pairs t)] (values v k))) + +(fn print [tbl] + "print a table" + (each [k v (pairs tbl)] + (let [table? (= (type v) :table)] + (print k v)))) + +(fn slice [t start stop] + "return a slice of a table" + (fcollect [i start (or stop (length t))] + (. t i))) { : contains + : flip : head : keys - : invert : print : slice : tail diff --git a/lib/table.test.fnl b/lib/table.test.fnl new file mode 100644 index 0000000..c004d3f --- /dev/null +++ b/lib/table.test.fnl @@ -0,0 +1,80 @@ +(let [{: contains + : flip + : head + : keys + : slice + : tail + } (require :lib.table) + {: describe + : test-end} (require :lib.test)] + +(describe "# TABLE" (fn [] + (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)}))) + + (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)})))) + + (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 []))}))) + + (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})))) + + + (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)})))) + + + (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/tableprint.fnl b/lib/tableprint.fnl deleted file mode 100644 index 4d9bfbe..0000000 --- a/lib/tableprint.fnl +++ /dev/null @@ -1,7 +0,0 @@ -; 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 deleted file mode 100644 index 24de254..0000000 --- a/lib/tail.fnl +++ /dev/null @@ -1,7 +0,0 @@ -; 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 deleted file mode 100644 index e507a0b..0000000 --- a/lib/tail.test.fnl +++ /dev/null @@ -1,19 +0,0 @@ -(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 index fbaaf8d..737275f 100644 --- a/lib/test.fnl +++ b/lib/test.fnl @@ -1,5 +1,25 @@ -(local {: pprint} (require :lib.tableprint)) -(local {: equal} (require :lib.equal)) +(local {:print pprint} (require :lib.table)) + +;; 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) (var plan 0) @@ -13,7 +33,7 @@ (fn test [obj] (let [{: given : should : actual : expected} obj - ok (if (equal actual expected) :ok "not ok") + ok (if (deep-equals actual expected) :ok "not ok") description (.. "Given " given " should " should) ] (set plan (+ 1 plan)) @@ -38,15 +58,15 @@ (local print-header (once (fn [] (print "TAP version 14")))) -(fn desc [str cb] +(fn describe [str cb] (print-header) (print (.. "#" str)) - (cb test) - ) -(fn end [] - (print (.. 1 ".." plan)) - ) + (cb test)) + +(fn test-end [] + (print (.. 1 ".." plan))) -{:describe desc - : end} +{: describe + : deep-equals + : test-end} diff --git a/lib/test.test.fnl b/lib/test.test.fnl index 7958141..81ddedd 100644 --- a/lib/test.test.fnl +++ b/lib/test.test.fnl @@ -1,19 +1,53 @@ -(let [{: describe :end test-end} (require :lib.test)] +(let [{: describe + : test-end + : deep-equals + } (require :lib.test)] + + ;; just a little something to test with (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)))) + y (or y 0)] + (+ x y))) + + (describe "# TEST" (fn [] + (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})))) + + (describe "equal()" (fn [t] + (t {:given "two equal tables" + :should "return true" + :expected true + :actual (deep-equals [:orange :apple :pear] [:orange :apple :pear]) }) + (t {:given "two different tables" + :should "return false" + :expected false + :actual (deep-equals [:apple :pear] [:orange :apple :pear]) }) + (t {:given "equal strings" + :should "be true" + :expected true + :actual (deep-equals :apple :apple) }) + (t {:given "different strings" + :should "be false" + :expected false + :actual (deep-equals :apple :pear) }) + (t {:given "equal bools" + :should "be true" + :expected true + :actual (deep-equals true true) }) + (t {:given "different strings" + :should "be false" + :expected false + :actual (deep-equals true false) }))) + + (test-end)))) diff --git a/main.fnl b/main.fnl index 56c0536..c205454 100644 --- a/main.fnl +++ b/main.fnl @@ -1,148 +1,12 @@ -;; helper and utility functions +(local {: game} (require :src.game)) (local { : str : tbl - : all-mills? - :mill-at? mill-at-maker - :space-is-neighbor? space-is-neighbor-maker - :no-moves? no-moves-maker } (require :lib.index)) -;; constants...more like just strings (local const (require :lib.constants)) -;; front-loading with some partials -(local mill-at? (partial mill-at-maker const.mills)) -(local space-is-neighbor? (partial space-is-neighbor-maker const.neighbors)) -(local no-moves? (partial no-moves-maker const.neighbors)) - -;; there are three phases of play: -;; placing, moving, and flying. -;; (plus one for capturing) -;; (plus one for game-over) -(local stages { - :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! jk the cows are fine. the game's just over okay -}) - - -;; story mode: -;; there are two players -;; their names are WIGI and MALO -(local player { - :one 1 ;; wigi has light cows - :two 2 ;; malo has DARK cows >:) -}) - - -; return the numerical index (1-24) of a [A-Za-z0-9] formatted move -(fn index-of-move [m] - (assert (= "string" (type m)) "index-of-move needs a string argument") - (let [upper (string.upper m) - rev (string.reverse upper) - idx (tbl.head (icollect [i v (ipairs const.spaces)] - (if (or (= v upper) (= v rev)) i)))] - idx)) - - -(fn player-count [moves player] - (accumulate [count 0 - _ x (ipairs moves)] - (if (= x player) (+ count 1) count))) - - -;; game state object -(local game { - :player player.one - :stage stages.placing - :update (fn [self move] - (case self.stage - 4 ;; CAPTURE - (do - (tset self.moves (index-of-move move) 0) - (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) - movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) - endtime (and (self:phase-two?) - (or (< (length (icollect [_ m (ipairs self.moves)] (if (= m 1) 1))) 3) - (< (length (icollect [_ m (ipairs self.moves)] (if (= m 2) 2))) 3)))] - (tset self :stage (if endtime stages.complete - flytime stages.flying - movetime stages.moving - stages.placing)) - (if (not endtime) (tset self :player (self:next-player))) - )) - 1 ;; PLACING - (do - (set self.pieces-placed (+ 1 self.pieces-placed)) - (tset self :stage (if (self:phase-two?) stages.moving stages.placing)) - (tset self.moves (index-of-move move) self.player) - (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves self.player))) - movetime (and (self:phase-two?) (> (player-count self.moves self.player) 3)) - capturetime (mill-at? self.moves (index-of-move move))] - (tset self :stage (if - capturetime stages.capture - flytime stages.flying - movetime stages.moving - stages.placing)) - (if (not capturetime) (tset self :player (self:next-player))))) - 2 ;; MOVING - (let [from (index-of-move (string.sub move 1 2)) - to (index-of-move (string.sub move -2 -1))] - (tset self.moves from 0) - (tset self.moves to self.player) - (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) - movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) - capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1))) - endtime (no-moves? self.moves (self:next-player))] - (tset self :stage (if - capturetime stages.capture - flytime stages.flying - movetime stages.moving - endtime stages.complete - stages.placing)) - (if (not capturetime) (tset self :player (self:next-player))))) - 3 ;; FLYING - (let [from (index-of-move (string.sub move 1 2)) - to (index-of-move (string.sub move -2 -1))] - (tset self.moves from 0) - (tset self.moves to self.player) - (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) - movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) - capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1)))] - (tset self :stage (if - capturetime stages.capture - flytime stages.flying - movetime stages.moving - stages.placing)) - (if (not capturetime) (tset self :player (self:next-player))))) - 5 ;; COMPLETE - (print "Unreachable!") - ) - (tset self :turns (+ self.turns 1)) - ) - :next-player (fn [self] (if (= player.one self.player) player.two player.one)) - :pieces-placed 0 - :turns 0 - ; so basically there's phase 1 where you place your checkers - ; and then phase 2 when you move and fly around trying to capture pieces - :phase-two? (fn [self] (> self.pieces-placed 17)) - :init (fn [self] - ; 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 - ; NOTE: I think it might be a good idea to make moves - ; a list of moves. so that there can be undo and history - (set self.moves (fcollect [i 1 24] 0)) - ) -}) (game:init) - ; Print! That! Board! (fn print-board [board moves] (var index 1) @@ -155,82 +19,10 @@ (print (string.format row-template (table.unpack myslice))) (set index offset))) (print row)))) - (print (.. "Stage: " (str.capitalize (. (tbl.invert stages) game.stage)))) + (print (.. "Stage: " (str.capitalize (. (tbl.flip const.stages) game.stage)))) (print (.. "Player " game.player "'s turn:"))) -(local with-board (partial print-board const.board)) - - -; add the inverse of each valid move -; e.g. 1A = A1 -(fn add-reverse-moves [] - (let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))] - (each [_ v (ipairs reversed)] - (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] (tbl.contains const.spaces (string.upper m))) - -; is the space represented by a [A-Za-z0-9] move unoccupied? -(fn space-is-unoccupied? [m] - (let [unoccupied? 0] ; i.e. is move equal to 0 - (= unoccupied? (. game.moves (index-of-move m))))) - -; is the space m occupied by the player's opponent? -(fn space-is-occupied-by-opponent? [m] - "is the space m occupied by the player's opponent?" - (let [opponent (if (= game.player 1) 2 1) - result (= opponent (. game.moves (index-of-move m))) ] - result)) - -; checks that the first 2 charcters and the last 2 characters -; of a string are legal spaces -; moving-format is the same as flying-format -(fn moving-format? [m] - (let [from (string.sub m 1 2) - to (string.sub m -2 -1)] - (and (>= (length m) 4) (space-exists? from) (space-exists? to)))) - - -; is this a legal move? -(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 the same move.")) - (or (space-is-unoccupied? move) - (print "That space is occupied!"))) - (and - (= stages.capture game.stage) - (or (space-is-occupied-by-opponent? move) - (print "Choose an opponent's piece to remove.")) - (or (or (all-mills? game.moves game.player) - (not (mill-at? game.moves (index-of-move move)))) - (print "Ma'am, it is ILLEGAL to break up a mill.") - )) - (and - (= stages.moving game.stage) - (or (moving-format? move) - (print "Try a move like A1A2 or A7 D7")) - (or (not (space-is-occupied-by-opponent? (string.sub move 1 2))) - (print "That's not yours, don't touch it.")) - (or (space-is-unoccupied? (string.sub move -2 -1)) - (print "That space is occupied!")) - (or (space-is-neighbor? (index-of-move (string.sub move 1 2)) (index-of-move (string.sub move -2 -1))) - (print "That ain't your neighbor, Johnny")) ) - (and - (= stages.flying game.stage) - (or (moving-format? move) - (print "Try a move like A1A2 or A7 D7")) - (or (not (space-is-occupied-by-opponent? (string.sub move 1 2))) - (print "That's not yours, don't touch it.")) - (or (space-is-unoccupied? (string.sub move -2 -1)) - (print "That space is occupied!"))) - ) - ) +(local with-board (partial print-board const.board)) ; get player input @@ -240,14 +32,14 @@ (fn main [] ;; game loop - (while (not (= game.stage stages.complete)) + (while (not (= game.stage const.stages.complete)) (with-board game.moves) ;; validation loop (var is-valid false) (var move "") (while (not is-valid) (set move (get-move)) - (set is-valid (valid-move? move)) + (set is-valid (game.validate-move move)) (if (not is-valid) (print "Try again.") (do @@ -255,6 +47,5 @@ (game:update move))))) ;; game is complete (print "Congratulations!") - (print (string.format "Player %d is the winner!" game.player)) -) + (print (string.format "Player %d is the winner!" game.player))) (main) diff --git a/src/game.fnl b/src/game.fnl new file mode 100644 index 0000000..b48a6ac --- /dev/null +++ b/src/game.fnl @@ -0,0 +1,204 @@ +;; helper and utility functions +(local { + : tbl + } (require :lib.index)) +(local { + : all-mills? + :mill-at? mill-at-maker + :no-moves? no-moves-maker + :space-is-neighbor? space-is-neighbor-maker + } (require :lib.game.index)) +(local const (require :lib.constants)) +;; front-loading with some partials +(local mill-at? (partial mill-at-maker const.mills)) +(local space-is-neighbor? (partial space-is-neighbor-maker const.neighbors)) +(local no-moves? (partial no-moves-maker const.neighbors)) + + +;; story mode: +;; there are two players +;; their names are WIGI and MALO +(local player { + :one 1 ;; wigi has light cows + :two 2 ;; malo has DARK cows >:) +}) + + +; return the numerical index (1-24) of a [A-Za-z0-9] formatted move +(fn index-of-move [m] + (assert (= "string" (type m)) "index-of-move needs a string argument") + (let [upper (string.upper m) + rev (string.reverse upper) + idx (tbl.head (icollect [i v (ipairs const.spaces)] + (if (or (= v upper) (= v rev)) i)))] + idx)) + + +(fn player-count [moves player] + (accumulate [count 0 + _ x (ipairs moves)] + (if (= x player) (+ count 1) count))) + + +;; game state object +(local game { + :player player.one + :stage const.stages.placing + :update (fn [self move] + (case self.stage + 4 ;; CAPTURE + (do + (tset self.moves (index-of-move move) 0) + (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) + movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) + endtime (and (self:phase-two?) + (or (< (length (icollect [_ m (ipairs self.moves)] (if (= m 1) 1))) 3) + (< (length (icollect [_ m (ipairs self.moves)] (if (= m 2) 2))) 3)))] + (tset self :stage (if endtime const.stages.complete + flytime const.stages.flying + movetime const.stages.moving + const.stages.placing)) + (if (not endtime) (tset self :player (self:next-player))) + )) + 1 ;; PLACING + (do + (set self.pieces-placed (+ 1 self.pieces-placed)) + (tset self :stage (if (self:phase-two?) const.stages.moving const.stages.placing)) + (tset self.moves (index-of-move move) self.player) + (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves self.player))) + movetime (and (self:phase-two?) (> (player-count self.moves self.player) 3)) + capturetime (mill-at? self.moves (index-of-move move))] + (tset self :stage (if + capturetime const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + const.stages.placing)) + (if (not capturetime) (tset self :player (self:next-player))))) + 2 ;; MOVING + (let [from (index-of-move (string.sub move 1 2)) + to (index-of-move (string.sub move -2 -1))] + (tset self.moves from 0) + (tset self.moves to self.player) + (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) + movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) + capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1))) + endtime (no-moves? self.moves (self:next-player))] + (tset self :stage (if + capturetime const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + endtime const.stages.complete + const.stages.placing)) + (if (not capturetime) (tset self :player (self:next-player))))) + 3 ;; FLYING + (let [from (index-of-move (string.sub move 1 2)) + to (index-of-move (string.sub move -2 -1))] + (tset self.moves from 0) + (tset self.moves to self.player) + (let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player)))) + movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3)) + capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1)))] + (tset self :stage (if + capturetime const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + const.stages.placing)) + (if (not capturetime) (tset self :player (self:next-player))))) + 5 ;; COMPLETE + (print "Unreachable!") + ) + (tset self :turns (+ self.turns 1)) + ) + :next-player (fn [self] (if (= player.one self.player) player.two player.one)) + :pieces-placed 0 + :turns 1 + ; so basically there's phase 1 where you place your checkers + ; and then phase 2 when you move and fly around trying to capture pieces + :phase-two? (fn [self] (> self.pieces-placed 17)) + :init (fn [self] + ; 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 + ; NOTE: I think it might be a good idea to make moves + ; a list of moves. so that there can be undo and history + (set self.moves (fcollect [i 1 24] 0)) + ) +}) + + +; add the inverse of each valid move +; e.g. 1A = A1 +(fn add-reverse-moves [] + (let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))] + (each [_ v (ipairs reversed)] + (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] (tbl.contains const.spaces (string.upper m))) + + +; is the space represented by a [A-Za-z0-9] move unoccupied? +(fn space-is-unoccupied? [m] + (let [unoccupied? 0] ; i.e. is move equal to 0 + (= unoccupied? (. game.moves (index-of-move m))))) + +; is the space m occupied by the player's opponent? +(fn space-is-occupied-by-opponent? [m] + "is the space m occupied by the player's opponent?" + (let [opponent (if (= game.player 1) 2 1) + result (= opponent (. game.moves (index-of-move m))) ] + result)) + +; checks that the first 2 charcters and the last 2 characters +; of a string are legal spaces +; moving-format is the same as flying-format +(fn moving-format? [m] + (let [from (string.sub m 1 2) + to (string.sub m -2 -1)] + (and (>= (length m) 4) (space-exists? from) (space-exists? to)))) + + +; is this a legal move? +(fn valid-move? [move] + (or + (and + (= const.stages.placing game.stage) + (or (space-exists? move) + (print "That space does not exist!\nHint: 1a 1A A1 a1 are all the same move.")) + (or (space-is-unoccupied? move) + (print "That space is occupied!"))) + (and + (= const.stages.capture game.stage) + (or (space-is-occupied-by-opponent? move) + (print "Choose an opponent's piece to remove.")) + (or (or (all-mills? game.moves game.player) + (not (mill-at? game.moves (index-of-move move)))) + (print "Ma'am, it is ILLEGAL to break up a mill.") + )) + (and + (= const.stages.moving game.stage) + (or (moving-format? move) + (print "Try a move like A1A2 or A7 D7")) + (or (not (space-is-occupied-by-opponent? (string.sub move 1 2))) + (print "That's not yours, don't touch it.")) + (or (space-is-unoccupied? (string.sub move -2 -1)) + (print "That space is occupied!")) + (or (space-is-neighbor? (index-of-move (string.sub move 1 2)) (index-of-move (string.sub move -2 -1))) + (print "That ain't your neighbor, Johnny")) ) + (and + (= const.stages.flying game.stage) + (or (moving-format? move) + (print "Try a move like A1A2 or A7 D7")) + (or (not (space-is-occupied-by-opponent? (string.sub move 1 2))) + (print "That's not yours, don't touch it.")) + (or (space-is-unoccupied? (string.sub move -2 -1)) + (print "That space is occupied!"))))) + +(tset game :validate-move valid-move?) + +{: game} -- cgit 1.4.1-2-gfad0