9mm/main.fnl

; Introducing:
; Nine Mens Morris
; The Game
;
; Featuring:
; Fennel
; The Language
;
; By:
; dozens
; the human
;
; Do you know what Nine Mens Morris looks like?
; It has three concentric rings, each containing eight spaces.
; Here's what it looks like:
;
; 1-----2-----3
; |     |     |
; | 4---5---6 |
; | |   |   | |
; | | 7-8-9 | |
; | | |   | | |
; 0-1-2   3-4-5  +10
; | | |   | | |
; | | 6-7-8 | |
; | |   |   | |
; | 9---0---1 |  +20
; |     |     |
; 2-----3-----4


;; helper and utility functions
(local {
  :contains contains
  :head head
  :mill? mill-maker
  :pprint pprint
  } (require :lib.index))


; there are three phases of play:
; placing, moving, and flying.
; (plus one for capturing)
; (plus one for complete)
(local stages {
  :placing  1
  :moving   2
  :flying   3
  :capture  4
  :complete 5
})


; there are two players
; their names are LUIGI and MARIO
(local player {
  :one 1 ;; luigi
  :two 2 ;; mario
})


; initialize moves[] to 0.
; this is the game state.
; shows which spaces are occupied by which players.
; 0 = unoccupied
; 1 = Player 1
; 2 = Player 2
(local moves (fcollect [i 1 24] 0))


(local rules {
; what moves are legal from each space
; slash what neighbors does each space have
  :neighbors [
    [1 2 10]
    [2 1 3 5]
    [3 2 15]
    [4 5 11]
    [5 2 4 6 8]
    [6 5 14]
    [7 8 12]
    [8 5 7 9]
    [9 8 13]
    [10 1 11 22]
    [11 4 10 12 19]
    [12 7 11 16]
    [13 9 14 18]
    [14 6 13 15 21]
    [15 3 14 24]
    [16 12 17]
    [17 16 18 20]
    [18 13 17]
    [19 11 20]
    [20 17 19 21 23]
    [21 14 20]
    [22 10 23]
    [23 20 22 24]
    [24 15 23]
  ]
; sixteen combinations of spaces form a mill
  :mills [
    [1 2 3]
    [4 5 6]
    [7 8 9]
    [10 11 12]
    [13 14 15]
    [16 17 18]
    [19 20 21]
    [22 23 24]
    [1 10 22]
    [4 11 19]
    [7 12 16]
    [2 5 8]
    [17 20 23]
    [9 13 18]
    [6 14 21]
    [3 15 24]
  ]
})

(fn mill? [state move] (partial mill-maker rules.mills))


; game state object
(local game {
  :player player.one
  :stage stages.placing
  :update (fn [self move]
             (if (mill? moves move)
               (do
                 (print "MILLLLLLLLLLLLL!")
                 (tset self :stage stages.capture)
                 )
               (tset self :player (if (= player.one self.player) player.two player.one))
               )
             )
})





; This is what the game board looks like
; it's also used to display the state of the game
; the Xs are converted to "%d" later for string templating
; they are Xs here so that it looks pretty =)
(local board [
  "  1 2 3 4 5 6 7"
  "A x-----x-----x"
  "  |     |     |"
  "B | x---x---x |"
  "  | |   |   | |"
  "C | | x-x-x | |"
  "  | | |   | | |"
  "D x-x-x   x-x-x"
  "  | | |   | | |"
  "E | | x-x-x | |"
  "  | |   |   | |"
  "F | x---x---x |"
  "  |     |     |"
  "G x-----x-----x"
])




; Print! That! Board!
(fn print-board [board moves]
  (var total-count -2) ; lol,  m-a-g-i-c
                       ; just kidding, it's so that -2 + 3 = 1
                       ; which is where i want to start indexing my table
  (each [_ row (ipairs board)]
    (let [(template count) (string.gsub row "x" "%%d")]
      (if (> count 0)
        (do
          (set total-count (+ total-count count)) ; where i need that magic number on first iteration
          (print (string.format template (select total-count (table.unpack moves)))))
        (print row)))))
; `select` above does NOT do what i thought it did.
; i thought it would return the first x values given (select x values)
; instead it returns the rest of the table having discarded the first x values
; i think that `pick-values` probably does what i thought `select` does


; these are the only moves that are valid
; i am somewhat bothered by all the wasted space
; by 2-3A and 5-6A e.g.
; Incidentally these are all in order of appearance
; so when you find a match,
; you can also update that index of `moves` to the current player number
(local valid-spaces [
  "1A" "4A" "7A"
  "2B" "4B" "6B"
  "3C" "4C" "5C"
  "1D" "2D" "3D"
  "5D" "6D" "7D"
  "3E" "4E" "5E"
  "2F" "4F" "5F"
  "1G" "4G" "7G"
])
; add the inverse of each valid move
; e.g. 1A = A1
(fn add-reverse-moves []
  (let [reversed (icollect [_ v (ipairs valid-spaces)] (string.reverse v))]
    (each [_ v (ipairs reversed)]
      (table.insert valid-spaces v))))
(add-reverse-moves)


; does the move exist within the domain of valid spaces
(fn space-exists? [m] (contains valid-spaces (string.upper m)))

; return the numerical index of a "A1" formatted move
(fn index-of-move [m]
    (let [ upper (string.upper m)
           rev   (string.reverse upper)
           idx   (head (icollect [i v (ipairs valid-spaces)]
                         (if (or (= v upper) (= v rev)) i)))
         ]
         idx))

; is the space represented by a move ("A1") unoccupied?
(fn space-is-unoccupied? [m]
  (let [unoccupied? 0]
    (= unoccupied? (. moves (index-of-move m)))))

; is this a legal move?
; TODO: maybe some functional error handling here?
;   https://mostly-adequate.gitbook.io/mostly-adequate-guide/ch08#pure-error-handling
;   https://mostly-adequate.gitbook.io/mostly-adequate-guide/appendix_b#either
; or maybe all i need is a case-try statement..
;   https://fennel-lang.org/reference#case-try-for-matching-multiple-steps
;   update: i didn't really like that
; i think maybe i do want the monad after all..
; i'll come back to it later
(fn valid-move? [move]
  (or
    (and
      (= stages.placing game.stage)
      (or (space-exists? move) (print "That space does not exist!\nHint: 1a 1A A1 a1 are all valid moves."))
      (or (space-is-unoccupied? move) (print "That space is occupied!"))))
    (and
      ;; TODO: add capturing phase
      (= stages.capturing game.stage)
      )
    (and
      ;; TODO: add flying phase
      (= stages.flying game.stage)
      )
  )



; get player input
(fn get-move []
  (print (.. "Player " game.player "'s turn:"))
  (io.read))


(fn main []
  ;; game loop
  (while (not (= game.stage stages.complete))
    (print-board board moves)

    ;; validation loop
    (var is-valid false)
    (var move "")
    (while (not is-valid)
      (set move (get-move))
      (set is-valid (valid-move? move))
      (if (not is-valid)
        (print "Try again.")
        (do
          (print (.. "You chose " move))
          (tset moves (index-of-move move) game.player)
          (game:update move)
          )
      )
    )
  )
)
(main)