diff options
| -rw-r--r-- | doc/tilde30.t | 27 | ||||
| -rw-r--r-- | justfile | 9 | ||||
| -rw-r--r-- | lib/constants.fnl | 14 | ||||
| -rw-r--r-- | lib/contains.fnl | 7 | ||||
| -rw-r--r-- | lib/contains.test.fnl | 17 | ||||
| -rw-r--r-- | lib/either.test.fnl | 72 | ||||
| -rw-r--r-- | lib/equal.fnl | 22 | ||||
| -rw-r--r-- | lib/equal.test.fnl | 28 | ||||
| -rw-r--r-- | lib/game/README | 5 | ||||
| -rw-r--r-- | lib/game/all-mills.fnl (renamed from lib/all-mills.fnl) | 12 | ||||
| -rw-r--r-- | lib/game/all-mills.test.fnl (renamed from lib/all-mills.test.fnl) | 16 | ||||
| -rw-r--r-- | lib/game/index.fnl | 11 | ||||
| -rw-r--r-- | lib/game/mill.fnl (renamed from lib/mill.fnl) | 16 | ||||
| -rw-r--r-- | lib/game/mill.test.fnl (renamed from lib/mill.test.fnl) | 85 | ||||
| -rw-r--r-- | lib/game/no-moves.fnl (renamed from lib/no-moves.fnl) | 2 | ||||
| -rw-r--r-- | lib/game/no-moves.test.fnl (renamed from lib/no-moves.test.fnl) | 8 | ||||
| -rw-r--r-- | lib/game/space-is-neighbor.fnl (renamed from lib/space-is-neighbor.fnl) | 7 | ||||
| -rw-r--r-- | lib/game/space-is-neighbor.test.fnl (renamed from lib/space-is-neighbor.test.fnl) | 10 | ||||
| -rw-r--r-- | lib/head.fnl | 6 | ||||
| -rw-r--r-- | lib/head.test.fnl | 12 | ||||
| -rw-r--r-- | lib/index.fnl | 8 | ||||
| -rw-r--r-- | lib/keys.fnl | 7 | ||||
| -rw-r--r-- | lib/keys.test.fnl | 13 | ||||
| -rw-r--r-- | lib/kvflip.fnl | 6 | ||||
| -rw-r--r-- | lib/kvflip.test.fnl | 13 | ||||
| -rw-r--r-- | lib/slice.fnl | 5 | ||||
| -rw-r--r-- | lib/slice.test.fnl | 19 | ||||
| -rw-r--r-- | lib/string.fnl | 2 | ||||
| -rw-r--r-- | lib/string.test.fnl | 13 | ||||
| -rw-r--r-- | lib/table.fnl | 50 | ||||
| -rw-r--r-- | lib/table.test.fnl | 80 | ||||
| -rw-r--r-- | lib/tableprint.fnl | 7 | ||||
| -rw-r--r-- | lib/tail.fnl | 7 | ||||
| -rw-r--r-- | lib/tail.test.fnl | 19 | ||||
| -rw-r--r-- | lib/test.fnl | 42 | ||||
| -rw-r--r-- | lib/test.test.fnl | 70 | ||||
| -rw-r--r-- | main.fnl | 221 | ||||
| -rw-r--r-- | src/game.fnl | 204 |
38 files changed, 588 insertions, 584 deletions
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 @@ -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/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/all-mills.fnl b/lib/game/all-mills.fnl index 562bb97..e5b3d2b 100644 --- a/lib/all-mills.fnl +++ b/lib/game/all-mills.fnl @@ -1,4 +1,4 @@ -(local {: mill-at? } (require :lib.mill)) +(local {: mill-at? } (require :lib.game.mill)) (local {: mills } (require :lib.constants)) (fn toggle-player [p] (if (= p 1) 2 1)) @@ -6,16 +6,16 @@ (fn only-player-moves [moves player] (icollect [_ move (ipairs moves)] (if (= move player) player 0))) -(fn all-moves-are-mills? [moves player] +(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] - (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)) + (->> current-player + (toggle-player) + (only-player-moves all-moves) + (all-moves-are-mills? current-player))) {: all-mills? ;; do not use; just for testing: diff --git a/lib/all-mills.test.fnl b/lib/game/all-mills.test.fnl index 7f33ab1..055f6a5 100644 --- a/lib/all-mills.test.fnl +++ b/lib/game/all-mills.test.fnl @@ -1,19 +1,19 @@ (let [{: describe - :end test-end} (require :lib.test) + : test-end} (require :lib.test) {: all-mills? : toggle-player : only-player-moves : all-moves-are-mills? - } (require :lib.all-mills)] + } (require :lib.game.all-mills)] - (describe "all-mills" (fn [] - (describe "#toggle-player()" (fn [t] + (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] + (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 ] ] @@ -22,20 +22,20 @@ : expected :actual (only-player-moves moves 1) })))) - (describe "#all-moves-are-mills?()" (fn [t] + (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) + :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? moves 1) + :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/mill.fnl b/lib/game/mill.fnl index f9c8673..d15b53e 100644 --- a/lib/mill.fnl +++ b/lib/game/mill.fnl @@ -1,8 +1,9 @@ -(local {: contains} (require :lib.contains)) +(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))) + (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" @@ -17,7 +18,7 @@ _ m (ipairs moves)] (and acc (not= m 0) (= player m)))))) -(fn candidate-moves [candidates moves] +(fn candidate-moves [moves candidates] "Just turning board spaces into player moves" (icollect [_ spaces (ipairs candidates)] (icollect [_ space (ipairs spaces)] @@ -25,11 +26,10 @@ (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)) + (->> (get-candidates all-mills move) + (candidate-moves current-moves) + (move-mills) + (any))) {: mill-at? ;; not for consumption, diff --git a/lib/mill.test.fnl b/lib/game/mill.test.fnl index 04f7e97..604c759 100644 --- a/lib/mill.test.fnl +++ b/lib/game/mill.test.fnl @@ -1,21 +1,20 @@ (let [{: describe - :end test-end} (require :lib.test) + : test-end} (require :lib.test) {: mill-at? : get-candidates : move-mills : candidate-moves : any - } (require :lib.mill) + } (require :lib.game.mill) {: mills } (require :lib.constants) with-mills (partial mill-at? mills)] - (describe "Mill" (fn [] - (describe "#get-candidates()" (fn [t] + (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 ] - ] + 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 @@ -24,13 +23,11 @@ (t (let [move 1 expected [[1 2 3] [1 10 22]] - moves [ 0 0 0 ] - ] + 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) - })) + :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] @@ -39,82 +36,62 @@ {:given (string.format "a move of %d" move) :should "still return [[1 2 3] [1 10 22]]" : expected - :actual (get-candidates mills move) - })) - )) + :actual (get-candidates mills move) })))) - (describe "#any()" (fn [t] + (describe "any()" (fn [t] (t {:given "a table of false false true" :should "return true" :expected true - :actual (any [false false true]) - }) + :actual (any [false false true]) }) (t {:given "a table of true false" :should "return true" :expected true - :actual (any [true false]) - }) + :actual (any [true false]) }) (t {:given "a single false" :should "return false" :expected false - :actual (any [false]) - }) + :actual (any [false]) }) (t {:given "a single true" :should "return true" :expected true - :actual (any [true]) - }))) + :actual (any [true]) }))) - (describe "#move-mills()" (fn [t] + (describe "move-mills()" (fn [t] (t - (let [moves [[1 1 1] [0 2 2]] - ] + (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) - })) + :actual (move-mills moves) })) (t - (let [moves [[0 1 1] [0 2 2]] - ] + (let [moves [[0 1 1] [0 2 2]] ] {:given "no mills" :should "should return false" :expected [false false] - :actual (move-mills moves) - })) + :actual (move-mills moves) })) (t - (let [moves [[2 2 2] [2 0 0]] - ] + (let [moves [[2 2 2] [2 0 0]] ] {:given "mill, no mill" :should "should return true false" :expected [true false] - :actual (move-mills moves) - })) - )) + :actual (move-mills moves) })))) - (describe "#candidate-moves()" (fn [t] + (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] - ] + 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) - } - ) - ) - )) + :actual (candidate-moves moves spaces)})))) - (describe "#mill-at?()" (fn [t] + (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] - ] + 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) - })) + :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] @@ -123,8 +100,7 @@ {:given "a mill but not at Move" :should "return false" :expected false - :actual (with-moves move) - })) + :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] @@ -133,8 +109,7 @@ {:given "a mill" :should "return true" :expected true - :actual (with-moves move) - })) + :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] @@ -143,8 +118,6 @@ {:given "a mill" :should "return the opposite of false" :expected false - :actual (not (with-moves move)) - })) - )) + :actual (not (with-moves move)) })))) (test-end)))) diff --git a/lib/no-moves.fnl b/lib/game/no-moves.fnl index 591cb7c..02482cc 100644 --- a/lib/no-moves.fnl +++ b/lib/game/no-moves.fnl @@ -1,4 +1,4 @@ -(local {: tail} (require :lib.tail)) +(local {: tail} (require :lib.table)) (fn get-player-idxs [player moves] (icollect [i p (ipairs moves)] (when (= p player) i))) diff --git a/lib/no-moves.test.fnl b/lib/game/no-moves.test.fnl index db0613c..a94d60a 100644 --- a/lib/no-moves.test.fnl +++ b/lib/game/no-moves.test.fnl @@ -1,10 +1,10 @@ -(let [{: no-moves?} (require :lib.no-moves) +(let [{: no-moves?} (require :lib.game.no-moves) {: neighbors} (require :lib.constants) - {: describe :end test-end} (require :lib.test) + {: describe : test-end} (require :lib.test) with-neighbors (partial no-moves? neighbors) ] - (describe "no-moves()" (fn [t] + (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 ] @@ -47,5 +47,3 @@ })) (test-end)))) - - diff --git a/lib/space-is-neighbor.fnl b/lib/game/space-is-neighbor.fnl index 380607c..373feaf 100644 --- a/lib/space-is-neighbor.fnl +++ b/lib/game/space-is-neighbor.fnl @@ -1,6 +1,7 @@ -(local {: contains} (require :lib.contains)) -(local {: head} (require :lib.head)) -(local {: tail} (require :lib.tail)) +(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 diff --git a/lib/space-is-neighbor.test.fnl b/lib/game/space-is-neighbor.test.fnl index 7b0c0af..0ae7d4e 100644 --- a/lib/space-is-neighbor.test.fnl +++ b/lib/game/space-is-neighbor.test.fnl @@ -1,10 +1,9 @@ -(let [{: space-is-neighbor?} (require :lib.space-is-neighbor) +(let [{: space-is-neighbor?} (require :lib.game.space-is-neighbor) {: neighbors} (require :lib.constants) - {: describe :end test-end} (require :lib.test) - with-neighbors (partial space-is-neighbor? neighbors) - ] + {: describe : test-end} (require :lib.test) + with-neighbors (partial space-is-neighbor? neighbors) ] - (describe "space-is-neighbor()" (fn [t] + (describe "# SPACE-IS-NEIGHBOR" (fn [t] (t {:given "space of 3" :should "know 2 is a neighbor" :expected true @@ -19,4 +18,3 @@ :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/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/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)))) @@ -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} |