From ce09973e7cacccdc779f91b8e6e48a520b9f9f4d Mon Sep 17 00:00:00 2001
From: dozens
Date: Sat, 15 Jun 2024 21:15:59 -0600
Subject: feat: add end game

---
 doc/tilde30.t                   | 50 ++++++++++++++++++++++++
 lib/index.fnl                   | 20 +++-------
 lib/no-moves.fnl                | 26 +++++++++++++
 lib/no-moves.test.fnl           | 51 ++++++++++++++++++++++++
 lib/string.fnl                  |  4 ++
 lib/table.fnl                   | 17 ++++++++
 main.fnl                        | 86 +++++++++++++++++++++--------------------
 test/capture-mill-no-mill.dat   | 17 ++++++++
 test/capture-oops-all-mills.dat |  4 ++
 9 files changed, 220 insertions(+), 55 deletions(-)
 create mode 100644 lib/no-moves.fnl
 create mode 100644 lib/no-moves.test.fnl
 create mode 100644 lib/string.fnl
 create mode 100644 lib/table.fnl
 create mode 100644 test/capture-mill-no-mill.dat

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
+ }
diff --git a/main.fnl b/main.fnl
index fae5445..56c0536 100644
--- a/main.fnl
+++ b/main.fnl
@@ -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
-- 
cgit 1.4.1-2-gfad0