diff options
| -rw-r--r-- | lib/index.fnl | 4 | ||||
| -rw-r--r-- | lib/mill.fnl | 55 | ||||
| -rw-r--r-- | lib/mill.test.fnl | 199 | ||||
| -rw-r--r-- | main.fnl | 47 |
4 files changed, 160 insertions, 145 deletions
diff --git a/lib/index.fnl b/lib/index.fnl index 7579a1d..6323160 100644 --- a/lib/index.fnl +++ b/lib/index.fnl @@ -2,7 +2,7 @@ (local {: flip} (require :lib.flip)) (local {: head} (require :lib.head)) (local {: keys} (require :lib.keys)) -(local {: mill?} (require :lib.mill)) +(local {: mill-at?} (require :lib.mill)) (local {: pprint} (require :lib.tableprint)) (local {: slice} (require :lib.slice)) (local {: tail} (require :lib.tail)) @@ -12,7 +12,7 @@ : flip : head : keys - : mill? + : mill-at? : pprint : slice : tail diff --git a/lib/mill.fnl b/lib/mill.fnl index e3b3337..14df2e7 100644 --- a/lib/mill.fnl +++ b/lib/mill.fnl @@ -1,45 +1,42 @@ (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 candidates->moves [candidates current-moves move player] - "a list of the candidate mills expressed as current moves" - (icollect [_ spaces (ipairs candidates)] - (icollect [_ space (ipairs spaces)] - (if (= space move) :x (. current-moves space))))) - -(fn moves->mills [spaces player] - "a list of bools if the candidate moves + player are all the same" - (let [next-move (icollect [_ y (ipairs spaces)] - (icollect [_ x (ipairs y)] - (if (= x :x) player x))) ] - (icollect [_ move (ipairs next-move)] - (accumulate [acc true - idx m (ipairs move)] - (and acc (= player m)))))) - (fn any [t] - (accumulate [acc false + "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 mill? [all-mills current-moves next-move player] - "Does the current move for the current player create a mill?" - (let [candidates (get-candidates all-mills next-move) - moves (candidates->moves candidates current-moves next-move player) - mills (moves->mills moves player) - result (any mills)] - result)) - -{: mill? +(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 - : candidates->moves - : moves->mills + : candidate-moves + : move-mills : any } diff --git a/lib/mill.test.fnl b/lib/mill.test.fnl index 8bd3522..04f7e97 100644 --- a/lib/mill.test.fnl +++ b/lib/mill.test.fnl @@ -1,89 +1,48 @@ (let [{: describe :end test-end} (require :lib.test) - {: mill? + {: mill-at? : get-candidates - : candidates->moves - : moves->mills + : move-mills + : candidate-moves : any } (require :lib.mill) {: mills } (require :lib.constants) - with-mills (partial mill? mills)] - + 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) - })) + (let [move 3 + expected [[1 2 3] [3 15 24]] + moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + ] + {:given (string.format "a move of %d" move) + :should "return [[1 2 3] [3 15 24]]" + : expected + :actual (get-candidates mills move) + })) (t - (let [move 1 - expected [[1 2 3] [1 10 22]] - moves [ 0 0 0 ] - ] - {:given (string.format "a move of %d" move) - :should "return [[1 2 3] [1 10 22]]" - : expected - :actual (get-candidates mills move) - })))) - - - (describe "#candidates->moves()" (fn [t] - (t - (let [candidates [[1 2 3] [1 10 22]] - moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2] - expected [[:x 1 1] [:x 2 2]] - move 1 - player 2 - ] - {:given "a list of spaces and of current moves" - :should "return a map of spaces to moves" - : expected - :actual (candidates->moves candidates moves move player) - })) - (t - (let [candidates [[1 2 3] [3 15 24]] - moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] - expected [[1 1 :x] [:x 0 0]] - move 3 - player 1 - ] - {:given "a list of candidates and of current moves" - :should "return an x-map of spaces to moves" - : expected - :actual (candidates->moves candidates moves move player) - })))) - - - (describe "#moves->mills()" (fn [t] - (t - (let [spaces [[:x 1 1] [:x 2 2]] - moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2] - player 2 - ] - {:given "a list of spaces and of current moves" - :should "return a map of spaces to moves" - :expected [false true] - :actual (moves->mills spaces player) - })) - (t - (let [spaces [[1 1 :x] [:x 0 0]] - moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] - player 1 - ] - {:given "a list of canditate-moves and of current moves" - :should "return a map of spaces to moves" - :expected [true false] - :actual (moves->mills spaces player) - })))) - - + (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" @@ -106,36 +65,86 @@ :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?()" (fn [t] + (describe "#mill-at?()" (fn [t] (t (let [move 1 - player 1 - moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + 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 (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) - :should "not be a mill" + {:given "a mill but not at Move" + :should "return false" :expected false - :actual (with-moves move player) + :actual (with-moves move) })) (t - (let [move 3 - player 1 - moves [1 1 0] + (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 (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) - :should "be a mill" + {:given "a mill" + :should "return true" :expected true - :actual (with-moves move player) + :actual (with-moves move) })) (t - (let [move 3 - player 1 - moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + (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 (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) - :should "be a mill" - :expected true - :actual (with-moves move player) - })))) + {:given "a mill" + :should "return the opposite of false" + :expected false + :actual (not (with-moves move)) + })) + )) + (test-end)))) diff --git a/main.fnl b/main.fnl index d9ec3b4..9954984 100644 --- a/main.fnl +++ b/main.fnl @@ -5,12 +5,12 @@ : flip : pprint : slice - :mill? mill-maker + :mill-at? mill-at-maker } (require :lib.index)) ;; constants...more like just strings (local const (require :lib.constants)) ;; front-loading mill with a partial -(local mill? (partial mill-maker const.mills)) +(local mill-at? (partial mill-at-maker const.mills)) ; there are three phases of play: @@ -40,6 +40,7 @@ ; 0 = unoccupied ; 1 = Player 1 ; 2 = Player 2 +;; TODO: move this to game.moves? (local moves (fcollect [i 1 24] 0)) @@ -48,14 +49,21 @@ :player player.one :stage stages.placing :update (fn [self move] - (if (mill? moves move self.player) - (do - (print "Mooooooo") - (tset self :stage stages.capture) - ) - (tset self :player (if (= player.one self.player) player.two player.one)) - ) - ) + (case self.stage + 4 ;; capture + (do + (tset moves move 0) + (tset self :player (self:next-player)) + (tset self :stage stages.placing) + ) + 1 ;; placing + (if (mill-at? moves move) + (tset self :stage stages.capture) + (tset self :player (self:next-player)) + ) + ) + ) + :next-player (fn [self] (if (= player.one self.player) player.two player.one)) }) @@ -72,8 +80,8 @@ (do (let [offset (+ index slots) myslice (slice moves index offset)] - (print (string.format row-template (table.unpack myslice))) - (set index offset))) + (print (string.format row-template (table.unpack myslice))) + (set index offset))) (print row)))) (print (.. "Stage: " (string-upper (. (flip stages) game.stage)))) (print (.. "Player " game.player "'s turn:"))) @@ -107,8 +115,9 @@ (fn space-is-occupied-by-opponent? [m] - (let [opponent (if (= game.player 1) 2 1)] - (= opponent (. moves (index-of-move m))))) + (let [opponent (if (= game.player 1) 2 1) + result (= opponent (. moves (index-of-move m))) ] + result)) @@ -126,14 +135,15 @@ (and (= stages.placing game.stage) (or (space-exists? move) - (print "That space does not exist!\nHint: 1a 1A A1 a1 are all equal moves.")) + (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 - ;; TODO: add capturing phase - (= stages.capturing game.stage) - (or (space-is-occupied-by-opponent? move) + (= stages.capture game.stage) + (or (space-is-occupied-by-opponent? move) (print "Choose an opponent's piece to remove.")) + (or (not (mill-at? moves (index-of-move move))) + (print "Ma'am, it is ILLEGAL to break up a mill.")) ) (and ;; TODO: add flying phase @@ -143,7 +153,6 @@ ) - ; get player input (fn get-move [] (io.read)) |