diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/game.fnl | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/src/game.fnl b/src/game.fnl new file mode 100644 index 0000000..b48a6ac --- /dev/null +++ b/src/game.fnl @@ -0,0 +1,204 @@ +;; helper and utility functions +(local { + : tbl + } (require :lib.index)) +(local { + : all-mills? + :mill-at? mill-at-maker + :no-moves? no-moves-maker + :space-is-neighbor? space-is-neighbor-maker + } (require :lib.game.index)) +(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)) + + +;; 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 const.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 const.stages.complete + flytime const.stages.flying + movetime const.stages.moving + const.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?) const.stages.moving const.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 const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + const.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 const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + endtime const.stages.complete + const.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 const.stages.capture + flytime const.stages.flying + movetime const.stages.moving + const.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 1 + ; 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)) + ) +}) + + +; 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 + (= const.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 + (= const.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 + (= const.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 + (= const.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!"))))) + +(tset game :validate-move valid-move?) + +{: game} |