feat: capturing cannot break a mill

refactors the way mill? is written to make it a little more versatile

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

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]
+(fn candidate-moves [candidates moves]
-  "Does the current move for the current player create a mill?"
+  "Just turning board spaces into player moves"
-  (let [candidates (get-candidates all-mills next-move)
+  (icollect [_ spaces (ipairs candidates)]
-        moves (candidates->moves candidates current-moves next-move player)
+            (icollect [_ space (ipairs spaces)]
-        mills (moves->mills moves player)
+                      (. moves space))))
-        result (any mills)]
-		result))
 
-{: mill?
+(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
+ : candidate-moves
- : moves->mills
+ : move-mills
  : any
  }

lib/mill.test.fnl

@@ -1,89 +1,48 @@
 (let [{: describe
        :end test-end} (require :lib.test)
-      {: mill?
+      {: mill-at?
        : get-candidates
-       : candidates->moves
+       : move-mills
-       : moves->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
+          (let [move 3
-							 expected [[1 2 3] [3 15 24]]
+                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)
+            {:given (string.format "a move of %d" move)
-					 :should "return [[1 2 3] [3 15 24]]" 
+            :should "return [[1 2 3] [3 15 24]]" 
-           : expected 
+            : expected 
-           :actual (get-candidates mills move)
+            :actual (get-candidates mills move)
-           }))
+            }))
         (t
-         (let [move 1
+          (let [move 1
-							 expected [[1 2 3] [1 10 22]]
+                expected [[1 2 3] [1 10 22]]
-               moves [ 0 0 0 ]
+                moves [ 0 0 0 ]
-							]
+               ]
-				 	{:given (string.format "a move of %d" move)
+            {:given (string.format "a move of %d" move)
-					 :should "return [[1 2 3] [1 10 22]]" 
+            :should "return [[1 2 3] [1 10 22]]" 
-           : expected 
+            : expected 
-           :actual (get-candidates mills move)
+            :actual (get-candidates mills move)
-           }))))
+            }))
-				
+        (t
-
+          (let [move 1
-    (describe "#candidates->moves()" (fn [t]
+                moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
-          (t 
+                expected [[1 2 3] [1 10 22]]
-						(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]
+            {:given (string.format "a move of %d" move)
-								  expected [[:x 1 1] [:x 2 2]]
+            :should "still return [[1 2 3] [1 10 22]]" 
-								  move 1
+            : expected 
-								  player 2
+            :actual (get-candidates mills move)
-								  ]
+            }))
-							 {: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)
-								}))))
-
-
     (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 "#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]
-								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 "no mills"
-            {:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
+             :should "return false"
-             :should "not be a mill"
              :expected false
-             :actual (with-moves move player)
+             :actual (mill-at? mills moves move)
              }))
         (t 
-          (let [move 3
+          (let [move 4
-                player 1
+                moves [1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
-                moves [1 1 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 ","))
+            {:given "a mill but not at Move"
-             :should "be a mill"
+             :should "return false"
-             :expected true
+             :expected false
-             :actual (with-moves move player)
+             :actual (with-moves move)
              }))
         (t 
-          (let [move 3
+          (let [move 1
-                player 1
+                moves [2 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 ]
+                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 ","))
+            {:given "a mill"
-             :should "be 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))))

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)
+    (case self.stage
-               (do
+      4 ;; capture
-                 (print "Mooooooo")
+        (do
-                 (tset self :stage stages.capture)
+          (tset moves move 0)
-                 )
+          (tset self :player (self:next-player))
-               (tset self :player (if (= player.one self.player) player.two player.one))
+          (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)))
+            (print (string.format row-template (table.unpack myslice)))
-						(set index offset)))
+            (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)]
+  (let [opponent (if (= game.player 1) 2 1)
-    (= opponent (. moves (index-of-move m)))))
+        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.capture game.stage)
-      (= stages.capturing game.stage)
+      (or (space-is-occupied-by-opponent? move)
-			(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))