dozens
/
9mm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

feat: capturing cannot break a mill 

refactors the way mill? is written to make it a little more versatile
main
dozens 2024-06-03 14:41:37 -06:00 committed by dozens
parent 7c07d6e6ec
commit 7776b2011a
4 changed files with 160 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lib/index.fnl
View File

@ -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

49
lib/mill.fnl
View File

@ -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]
"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)]
(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?
{: mill-at?
;; not for consumption,
;; just for testing:
: get-candidates
: candidates->moves
: moves->mills
: candidate-moves
: move-mills
: any
}

153
lib/mill.test.fnl
View File

@ -1,14 +1,13 @@
(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]
@ -31,58 +30,18 @@
: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
(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 "a list of candidates and of current moves"
:should "return an x-map of spaces to moves"
{:given (string.format "a move of %d" move)
:should "still return [[1 2 3] [1 10 22]]"
: 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)
:actual (get-candidates mills move)
}))
(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)
}))))
))
(describe "#any()" (fn [t]
(t {:given "a table of false false 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 "#mill?()" (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]
]
{: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
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]
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 "no mills"
:should "return false"
:expected false
:actual (with-moves move player)
:actual (mill-at? mills moves move)
}))
(t
(let [move 3
player 1
moves [1 1 0]
(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 "be a mill"
:expected true
:actual (with-moves move player)
{:given "a mill but not at Move"
:should "return false"
:expected false
: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"
{:given "a mill"
:should "return true"
:expected true
:actual (with-moves move player)
}))))
: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))))

33
main.fnl
View File

@ -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)
(case self.stage
4 ;; capture
(do
(print "Mooooooo")
(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 (if (= player.one self.player) player.two player.one))
(tset self :player (self:next-player))
)
)
)
:next-player (fn [self] (if (= player.one self.player) player.two player.one))
})
@ -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)
(= 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))