From c7b2c982004e350f5e3032321baadfc9021b6bad Mon Sep 17 00:00:00 2001
From: dozens
Date: Thu, 20 Jun 2024 09:17:06 -0600
Subject: 🗄️ big tidy up

- isolate core game logic and move it to src/game.fnl
- main.fnl should be just the ui now
- move all table funcs into lib/table
- move all (1) string funcs into lib/string
- move all game funcs into lib/game/
---
 lib/game/README                     |   5 ++
 lib/game/all-mills.fnl              |  25 ++++++++
 lib/game/all-mills.test.fnl         |  41 ++++++++++++
 lib/game/index.fnl                  |  11 ++++
 lib/game/mill.fnl                   |  41 ++++++++++++
 lib/game/mill.test.fnl              | 123 ++++++++++++++++++++++++++++++++++++
 lib/game/no-moves.fnl               |  26 ++++++++
 lib/game/no-moves.test.fnl          |  49 ++++++++++++++
 lib/game/space-is-neighbor.fnl      |  19 ++++++
 lib/game/space-is-neighbor.test.fnl |  20 ++++++
 10 files changed, 360 insertions(+)
 create mode 100644 lib/game/README
 create mode 100644 lib/game/all-mills.fnl
 create mode 100644 lib/game/all-mills.test.fnl
 create mode 100644 lib/game/index.fnl
 create mode 100644 lib/game/mill.fnl
 create mode 100644 lib/game/mill.test.fnl
 create mode 100644 lib/game/no-moves.fnl
 create mode 100644 lib/game/no-moves.test.fnl
 create mode 100644 lib/game/space-is-neighbor.fnl
 create mode 100644 lib/game/space-is-neighbor.test.fnl

(limited to 'lib/game')

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/game/all-mills.fnl b/lib/game/all-mills.fnl
new file mode 100644
index 0000000..e5b3d2b
--- /dev/null
+++ b/lib/game/all-mills.fnl
@@ -0,0 +1,25 @@
+(local {: mill-at? } (require :lib.game.mill))
+(local {: mills } (require :lib.constants))
+
+(fn toggle-player [p] (if (= p 1) 2 1))
+
+(fn only-player-moves [moves player]
+  (icollect [_ move (ipairs moves)] (if (= move player) player 0)))
+
+(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]
+  (->> current-player
+       (toggle-player)
+       (only-player-moves all-moves)
+       (all-moves-are-mills? current-player)))
+
+{: all-mills?
+ ;; do not use; just for testing:
+ : toggle-player
+ : only-player-moves
+ : all-moves-are-mills?
+ }
diff --git a/lib/game/all-mills.test.fnl b/lib/game/all-mills.test.fnl
new file mode 100644
index 0000000..055f6a5
--- /dev/null
+++ b/lib/game/all-mills.test.fnl
@@ -0,0 +1,41 @@
+(let [{: describe
+       : test-end} (require :lib.test)
+      {: all-mills?
+       : toggle-player
+       : only-player-moves
+       : all-moves-are-mills?
+       } (require :lib.game.all-mills)]
+
+  (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]
+      (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 ]
+            ]
+        (t {:given "a bunch of moves and a player"
+            :should "filter out all the moves not belonging to the player"
+            : expected
+            :actual (only-player-moves moves 1)
+            }))))
+    (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? 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? 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/game/mill.fnl b/lib/game/mill.fnl
new file mode 100644
index 0000000..d15b53e
--- /dev/null
+++ b/lib/game/mill.fnl
@@ -0,0 +1,41 @@
+(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)))
+
+(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 candidate-moves [moves candidates]
+  "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?"
+  (->> (get-candidates all-mills move)
+       (candidate-moves current-moves) 
+       (move-mills)
+       (any)))
+
+{: mill-at?
+ ;; not for consumption,
+ ;; just for testing:
+ : get-candidates
+ : candidate-moves
+ : move-mills
+ : any
+ }
diff --git a/lib/game/mill.test.fnl b/lib/game/mill.test.fnl
new file mode 100644
index 0000000..604c759
--- /dev/null
+++ b/lib/game/mill.test.fnl
@@ -0,0 +1,123 @@
+(let [{: describe
+       : test-end} (require :lib.test)
+      {: mill-at?
+       : get-candidates
+       : move-mills
+       : candidate-moves
+       : any
+       } (require :lib.game.mill)
+      {: mills } (require :lib.constants)
+      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)
+            }))
+        (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) }))
+        (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"
+            :expected true
+            :actual (any [false false true]) })
+        (t {:given "a table of true false"
+            :should "return true"
+            :expected true
+            :actual (any [true false]) })
+        (t {:given "a single false"
+            :should "return false"
+            :expected false
+            :actual (any [false]) })
+        (t {:given "a single true"
+            :should "return true"
+            :expected true
+            :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 moves spaces)}))))
+
+    (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] ]
+            {: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 "a mill but not at Move"
+             :should "return false"
+             :expected false
+             :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 true"
+             :expected true
+             :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))))
diff --git a/lib/game/no-moves.fnl b/lib/game/no-moves.fnl
new file mode 100644
index 0000000..02482cc
--- /dev/null
+++ b/lib/game/no-moves.fnl
@@ -0,0 +1,26 @@
+(local {: tail} (require :lib.table))
+
+(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/game/no-moves.test.fnl b/lib/game/no-moves.test.fnl
new file mode 100644
index 0000000..a94d60a
--- /dev/null
+++ b/lib/game/no-moves.test.fnl
@@ -0,0 +1,49 @@
+(let [{: no-moves?} (require :lib.game.no-moves)
+      {: neighbors} (require :lib.constants)
+      {: describe : test-end} (require :lib.test)
+      with-neighbors (partial no-moves? neighbors)
+      ]
+
+  (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
+          ]
+        (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/game/space-is-neighbor.fnl b/lib/game/space-is-neighbor.fnl
new file mode 100644
index 0000000..373feaf
--- /dev/null
+++ b/lib/game/space-is-neighbor.fnl
@@ -0,0 +1,19 @@
+(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
+  ;; i.e. a number and not a string
+  (assert (= "number" (type from)) "from must be a number")
+  (assert (= "number" (type to)) "to must be a number")
+  (assert (= "table" (type all-neighbors)) "all-neighbors must be a table")
+
+  (let [neighborhood-list (icollect [_ n (ipairs all-neighbors)] (if (= from (head n)) n))
+        neighborhood (head neighborhood-list)
+        neighbors (tail neighborhood)
+        is-neighbor (contains neighbors to)]
+    is-neighbor))
+
+{: space-is-neighbor?}
diff --git a/lib/game/space-is-neighbor.test.fnl b/lib/game/space-is-neighbor.test.fnl
new file mode 100644
index 0000000..0ae7d4e
--- /dev/null
+++ b/lib/game/space-is-neighbor.test.fnl
@@ -0,0 +1,20 @@
+(let [{: space-is-neighbor?} (require :lib.game.space-is-neighbor)
+      {: neighbors} (require :lib.constants)
+      {: describe : test-end} (require :lib.test)
+      with-neighbors (partial space-is-neighbor? neighbors) ]
+
+  (describe "# SPACE-IS-NEIGHBOR" (fn [t]
+    (t {:given "space of 3"
+        :should "know 2 is a neighbor"
+        :expected true
+        :actual  (with-neighbors 3 2)})
+    (t {:given "space of 3"
+        :should "know 15 is a neighbor"
+        :expected true
+        :actual  (with-neighbors 3 15)})
+    (t {:given "space of 3"
+        :should "know 1 is not a neighbor"
+        :expected false
+        :actual  (with-neighbors 3 1)})
+
+    (test-end))))
-- 
cgit 1.4.1-2-gfad0