;; helper and utility functions (local { : contains : head : kvflip : pprint : slice : all-mills? :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 }) ;; story mode: ;; there are two players ;; their names are WIGI and MALO (local player { :one 1 ;; wigi has light cows :two 2 ;; malo has DARK cows >:) }) ; return the numerical index (1-24) of a [A-Za-z0-9] formatted move (fn index-of-move [m] (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)] (if (or (= v upper) (= v rev)) i)))] idx)) (fn player-count [moves player] (accumulate [count 0 _ x (ipairs moves)] (if (= x player) (+ count 1) count))) ;; game state object (local game { :player player.one :stage stages.placing :update (fn [self move] (case self.stage 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 movetime stages.moving stages.placing)))) 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) (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)) capturetime (mill-at? self.moves (index-of-move move))] (tset self :stage (if capturetime stages.capture flytime stages.flying movetime stages.moving stages.placing)) (if (not capturetime) (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))] (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)))] (tset self :stage (if capturetime stages.capture flytime stages.flying movetime stages.moving stages.placing)) (if (not capturetime) (tset self :player (self:next-player))))) 3 ;; FLYING (let [from (index-of-move (string.sub move 1 2)) 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)))] (tset self :stage (if capturetime stages.capture flytime stages.flying movetime stages.moving stages.placing)) (if (not capturetime) (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) ; 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) (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))))) ; is the space m occupied by the player's opponent? (fn space-is-occupied-by-opponent? [m] "is the space m occupied by the player's opponent?" (let [opponent (if (= game.player 1) 2 1) result (= opponent (. game.moves (index-of-move m))) ] result)) ; checks that the first 2 charcters and the last 2 characters ; of a string are legal spaces ; moving-format is the same as flying-format (fn moving-format? [m] (let [from (string.sub m 1 2) to (string.sub m -2 -1)] (and (>= (length m) 4) (space-exists? from) (space-exists? to)))) ; is this a legal move? (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 (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) (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 (= stages.flying 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!")) ) ) ) ; 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)