diff options
Diffstat (limited to 'main.fnl')
| -rw-r--r-- | main.fnl | 221 |
1 files changed, 6 insertions, 215 deletions
@@ -1,148 +1,12 @@ -;; helper and utility functions +(local {: game} (require :src.game)) (local { : 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: -;; 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 (tbl.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) - (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)) - (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:phase-two?) stages.moving stages.placing)) - (tset self.moves (index-of-move move) self.player) - (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 - 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: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 - (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: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 - flytime stages.flying - 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. - ; 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) - ; Print! That! Board! (fn print-board [board moves] (var index 1) @@ -155,82 +19,10 @@ (print (string.format row-template (table.unpack myslice))) (set index offset))) (print row)))) - (print (.. "Stage: " (str.capitalize (. (tbl.invert stages) game.stage)))) + (print (.. "Stage: " (str.capitalize (. (tbl.flip const.stages) game.stage)))) (print (.. "Player " game.player "'s turn:"))) -(local with-board (partial print-board const.board)) - - -; 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] (tbl.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!"))) - ) - ) +(local with-board (partial print-board const.board)) ; get player input @@ -240,14 +32,14 @@ (fn main [] ;; game loop - (while (not (= game.stage stages.complete)) + (while (not (= game.stage const.stages.complete)) (with-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)) + (set is-valid (game.validate-move move)) (if (not is-valid) (print "Try again.") (do @@ -255,6 +47,5 @@ (game:update move))))) ;; game is complete (print "Congratulations!") - (print (string.format "Player %d is the winner!" game.player)) -) + (print (string.format "Player %d is the winner!" game.player))) (main) |