path: root/main.fnl

;; helper and utility functions
(local {
  : contains
  : head
  : kvflip
  : pprint
  : slice
  :mill-at? mill-at-maker
  :space-is-neighbor? space-is-neighbor-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))


;; there are three phases of play:
;; placing, moving, and flying.
;; (plus one for capturing)
;; (plus one for game-over)
(local stages {
  :placing  1 ;; placing the cows
  :moving   2 ;; moving the cows
  :flying   3 ;; flying the cows
  :capture  4 ;; capture a cow (we do not shoot cows)
  :complete 5 ;; no more cows! jk the cows are fine. the game's just over okay
})


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


; return the numerical index (1-24) of a [A-Za-z0-9] formatted move
(fn index-of-move [m]
    (let [upper (string.upper m)
          rev   (string.reverse upper)
          idx   (head (icollect [i v (ipairs const.spaces)]
                        (if (or (= v upper) (= v rev)) i)))]
         idx))


;; game state object
(local game {
  :player player.one
  :stage stages.placing
  :update (fn [self move]
    (case self.stage
      4 ;; capture
        (do
             ;; TODO: capturing during moving is not working?
          (tset self.moves (index-of-move move) 0)
          (tset self :player (self:next-player))
          (tset self :stage (if (> self.pieces-placed 17) stages.moving stages.placing))
          (tset self.moves (index-of-move move) self.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.moves (index-of-move move) self.player)
          (if (mill-at? self.moves (index-of-move move))
              (tset self :stage stages.capture)
              (tset self :player (self:next-player))
              )
          )
      2 ;; moving
        (let [from (index-of-move (string.sub move 1 2))
              to  (index-of-move (string.sub move -2 -1))]
            (print "From" from)
            (print "To" to)
            (tset self.moves from 0)
            (tset self.moves to self.player)
            (if (mill-at? self.moves to)
                (tset self :stage stages.capture)
                (tset self :player (self:next-player))
                )
            )
    )
  )
  :next-player (fn [self] (if (= player.one self.player) player.two player.one))
  :pieces-placed 0
  :init (fn [self]
    ; 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
    ; NOTE: I think it might be a good idea to make moves
    ;       a list of moves. so that there can be undo and history
    (set self.moves (fcollect [i 1 24] 0))
  )
})
(game:init)


(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)
  (each [_ row (ipairs board)]
    (let [(row-template slots) (string.gsub row "x" "%%d")]
      (if (> slots 0)
        (do
          (let [offset (+ index slots)
                myslice (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 (.. "Player " game.player "'s turn:")))


; add the inverse of each valid move
; e.g. 1A = A1
(fn add-reverse-moves []
  (let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))]
    (each [_ v (ipairs reversed)]
      (table.insert const.spaces v)))) ;; oh nooooo i'm mutating a const????
(add-reverse-moves)


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


; is the space represented by a [A-Za-z0-9] move unoccupied?
(fn space-is-unoccupied? [m]
  (let [unoccupied? 0] ; i.e. is move equal to 0
    (= unoccupied? (. game.moves (index-of-move m)))))


(fn space-is-occupied-by-opponent? [m]
  (let [opponent (if (= game.player 1) 2 1)
        result (= opponent (. game.moves (index-of-move m))) ]
    result))


(fn moving-format? [m]
  (let [from (string.sub m 1 2)
        to (string.sub m -2 -1)]
    (and (space-exists? from) (space-exists? to))))

; is this a legal move?
; 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 the same move."))
      (or (space-is-unoccupied? move)
          (print "That space is occupied!")))
    (and
      (= stages.capture game.stage)
      (or (space-is-occupied-by-opponent? move)
          (print "Choose an opponent's piece to remove."))
      (or (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)
          (print "Try a move like A1A2 or A7 D7")) 
      (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!")) 
      (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")) 
      )
    (and
      ;; TODO: add flying phase
      (= stages.flying game.stage)
      )
    )
  )


; get player input
(fn get-move []
  (io.read))


(fn main []
  ;; game loop
  (while (not (= game.stage stages.complete))
    (print-board const.board game.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))
          (game:update move)
          )
        )
    )
  )
)
(main)