diff options
| -rw-r--r-- | doc/tilde30.t | 50 | ||||
| -rw-r--r-- | lib/index.fnl | 20 | ||||
| -rw-r--r-- | lib/no-moves.fnl | 26 | ||||
| -rw-r--r-- | lib/no-moves.test.fnl | 51 | ||||
| -rw-r--r-- | lib/string.fnl | 4 | ||||
| -rw-r--r-- | lib/table.fnl | 17 | ||||
| -rw-r--r-- | main.fnl | 86 | ||||
| -rw-r--r-- | test/capture-mill-no-mill.dat | 17 | ||||
| -rw-r--r-- | test/capture-oops-all-mills.dat | 4 |
9 files changed, 220 insertions, 55 deletions
diff --git a/doc/tilde30.t b/doc/tilde30.t index 5eeb436..a2dfb9f 100644 --- a/doc/tilde30.t +++ b/doc/tilde30.t @@ -197,5 +197,55 @@ you can break up a mill when capturing. up next: ending the game. +. +. +.IP 15 +implemented a game ending! +now if a player has fewer than 3 checkers, +the other player wins the game. +up next: +endgame edge case where if a player has 3 or more checkers, +but no available legal moves, +then they lose. +. +. +.IP "WEEK TWO REVIEW" +light week. +spent almost all of it on vacation +and not working on tilde30 at all. +nonetheless, +i'm mostly finished with the core of the game. +i have one small edge case to iron out +and then the game will be all the way complete. +i think for my first stretch goal, +i want to add some kind of generative story mode +based on player moves and decisions, etc. +so that by the time you're done with the game, +you have a unique little story to take with you. +i'm not sure whether i want to do a tracery grammar +type of thing.. +could be fun to try to write that. +well here's to tilde30 being half over! +hope everybody is having fun making progress +on your projects! +. +. +.IP 16 +I wrote the "no-moves?" function +to determine whether a player has no legal moves remaining. +And a test for it. +But integrating it created a bug I need to track down. +. +. +.IP 17 +Didn't fix the bug, +but rewrote "no-moves?" +using the "->" threading macro +which is neat. +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! + .pl \n[nl]u diff --git a/lib/index.fnl b/lib/index.fnl index 601ccb0..2eff31e 100644 --- a/lib/index.fnl +++ b/lib/index.fnl @@ -1,23 +1,15 @@ +(local str (require :lib.string)) +(local tbl (require :lib.table)) (local {: all-mills?} (require :lib.all-mills)) -(local {: contains} (require :lib.contains)) -(local {: head} (require :lib.head)) -(local {: keys} (require :lib.keys)) -(local {: kvflip} (require :lib.kvflip)) (local {: mill-at?} (require :lib.mill)) -(local {: pprint} (require :lib.tableprint)) -(local {: slice} (require :lib.slice)) (local {: space-is-neighbor?} (require :lib.space-is-neighbor)) -(local {: tail} (require :lib.tail)) +(local {: no-moves?} (require :lib.no-moves)) { + : str + : tbl : all-mills? - : contains - : head - : keys - : kvflip : mill-at? - : pprint - : slice + : no-moves? : space-is-neighbor? - : tail } diff --git a/lib/no-moves.fnl b/lib/no-moves.fnl new file mode 100644 index 0000000..591cb7c --- /dev/null +++ b/lib/no-moves.fnl @@ -0,0 +1,26 @@ +(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 new file mode 100644 index 0000000..db0613c --- /dev/null +++ b/lib/no-moves.test.fnl @@ -0,0 +1,51 @@ +(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/string.fnl b/lib/string.fnl new file mode 100644 index 0000000..510b0ed --- /dev/null +++ b/lib/string.fnl @@ -0,0 +1,4 @@ +(fn capitalize [s] + (.. (string.upper (string.sub s 1 1)) (string.sub s 2))) + +{: capitalize} diff --git a/lib/table.fnl b/lib/table.fnl new file mode 100644 index 0000000..f40c299 --- /dev/null +++ b/lib/table.fnl @@ -0,0 +1,17 @@ +(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)) + +{ + : contains + : head + : keys + : invert + : print + : slice + : tail + } @@ -1,19 +1,18 @@ ;; helper and utility functions (local { - : contains - : head - : kvflip - : pprint - : slice + : 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: @@ -43,7 +42,7 @@ (assert (= "string" (type m)) "index-of-move needs a string argument") (let [upper (string.upper m) rev (string.reverse upper) - idx (head (icollect [i v (ipairs const.spaces)] + idx (tbl.head (icollect [i v (ipairs const.spaces)] (if (or (= v upper) (= v rev)) i)))] idx)) @@ -63,19 +62,24 @@ 4 ;; CAPTURE (do (tset self.moves (index-of-move move) 0) - (tset self :player (self:next-player)) - (let [flytime (and (> self.pieces-placed 17) (= 3 (player-count self.moves self.player))) - movetime (and (> self.pieces-placed 17) (> (player-count self.moves self.player) 3))] - (tset self :stage (if flytime stages.flying + (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)))) + 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.pieces-placed 17) stages.moving stages.placing)) + (tset self :stage (if (self:phase-two?) stages.moving stages.placing)) (tset self.moves (index-of-move move) self.player) - (let [flytime (and (> self.pieces-placed 17) (= 3 (player-count self.moves self.player))) - movetime (and (> self.pieces-placed 17) (> (player-count self.moves self.player) 3)) + (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 @@ -88,13 +92,15 @@ to (index-of-move (string.sub move -2 -1))] (tset self.moves from 0) (tset self.moves to self.player) - (let [flytime (and (> self.pieces-placed 17) (= 3 (player-count self.moves (self:next-player)))) - movetime (and (> self.pieces-placed 17) (> (player-count self.moves (self:next-player)) 3)) - capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1)))] + (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 @@ -102,8 +108,8 @@ to (index-of-move (string.sub move -2 -1))] (tset self.moves from 0) (tset self.moves to self.player) - (let [flytime (and (> self.pieces-placed 17) (= 3 (player-count self.moves (self:next-player)))) - movetime (and (> self.pieces-placed 17) (> (player-count self.moves (self:next-player)) 3)) + (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 @@ -111,10 +117,17 @@ 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. @@ -130,11 +143,6 @@ (game:init) -; TODO: move to lib utility -(fn string-upper [s] - (.. (string.upper (string.sub s 1 1)) (string.sub s 2))) - - ; Print! That! Board! (fn print-board [board moves] (var index 1) @@ -143,12 +151,13 @@ (if (> slots 0) (do (let [offset (+ index slots) - myslice (slice moves index offset)] + myslice (tbl.slice moves index offset)] (print (string.format row-template (table.unpack myslice))) (set index offset))) (print row)))) - (print (.. "Stage: " (string-upper (. (kvflip stages) game.stage)))) + (print (.. "Stage: " (str.capitalize (. (tbl.invert stages) game.stage)))) (print (.. "Player " game.player "'s turn:"))) +(local with-board (partial print-board const.board)) ; add the inverse of each valid move @@ -161,7 +170,7 @@ ; does the move exist within the domain of valid spaces -(fn space-exists? [m] (contains const.spaces (string.upper m))) +(fn space-exists? [m] (tbl.contains const.spaces (string.upper m))) ; is the space represented by a [A-Za-z0-9] move unoccupied? @@ -201,8 +210,7 @@ (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) @@ -212,8 +220,7 @@ (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")) - ) + (print "That ain't your neighbor, Johnny")) ) (and (= stages.flying game.stage) (or (moving-format? move) @@ -221,8 +228,7 @@ (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!")) - ) + (print "That space is occupied!"))) ) ) @@ -235,8 +241,7 @@ (fn main [] ;; game loop (while (not (= game.stage stages.complete)) - (print-board const.board game.moves) - + (with-board game.moves) ;; validation loop (var is-valid false) (var move "") @@ -246,11 +251,10 @@ (if (not is-valid) (print "Try again.") (do - (print (.. "You chose " move)) - (game:update move) - ) - ) - ) - ) + (print (string.format "Turn %d: You chose %s" game.turns move)) + (game:update move))))) + ;; game is complete + (print "Congratulations!") + (print (string.format "Player %d is the winner!" game.player)) ) (main) diff --git a/test/capture-mill-no-mill.dat b/test/capture-mill-no-mill.dat new file mode 100644 index 0000000..71223ee --- /dev/null +++ b/test/capture-mill-no-mill.dat @@ -0,0 +1,17 @@ +# this creates a board with with to test the +# "Unless There's No Other Option" exception +# to the "No Breaking Up Mills" capture rule. +# Player 1 is in a position to capture F2 or +# F4, and should not be able to capture any +# checkers from the B2-B4-B6 mill +a1 +b2 +a4 +b4 +d7 +b6 +d7 +f2 +d6 +f4 +a7 diff --git a/test/capture-oops-all-mills.dat b/test/capture-oops-all-mills.dat index 96fec37..b23eddb 100644 --- a/test/capture-oops-all-mills.dat +++ b/test/capture-oops-all-mills.dat @@ -1,3 +1,7 @@ +## This sets up the board to test the "Unless There's No Other Option" +# exception to the "No Breaking Up Mills" capture rule. Player 2 is +# ready to capture, but all of Player 1's checkers are in a mill. +# So Player 2 should be able to capture any piece from the G1-G4-G7 mill. # PLACING PHASE (18 moves) A1 A4 |