9mm/main.fnl

186 lines
4.8 KiB
Fennel

;; helper and utility functions
(local {
: contains
: head
: flip
: pprint
: slice
: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-at? (partial mill-at-maker const.mills))
; there are three phases of play:
; placing, moving, and flying.
; (plus one for capturing)
; (plus one for complete)
(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!
})
; there are two players
; their names are LUIGI and MARIO
(local player {
:one 1 ;; luigi has light cows
:two 2 ;; mario has DARK cows >:)
})
; 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
;; TODO: move this to game.moves?
(local moves (fcollect [i 1 24] 0))
; game state object
(local game {
:player player.one
:stage stages.placing
:update (fn [self move]
(case self.stage
4 ;; capture
(do
(tset moves move 0)
(tset self :player (self:next-player))
(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))
})
(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 (. (flip 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)))
; 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))
; 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? (. moves (index-of-move m)))))
(fn space-is-occupied-by-opponent? [m]
(let [opponent (if (= game.player 1) 2 1)
result (= opponent (. moves (index-of-move m))) ]
result))
; 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 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? moves (index-of-move move)))
(print "Ma'am, it is ILLEGAL to break up a mill."))
)
(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 moves)
;; validation loop
(var is-valid false)
(var move "")
(while (not is-valid)
(set move (get-move))
(set is-valid (valid-move? move))
(let [idx (index-of-move move)]
(if (not is-valid)
(print "Try again.")
(do
(print (.. "You chose " move))
(tset moves idx game.player)
(game:update idx)
)
)
)
)
)
)
(main)