261 lines
9.6 KiB
Fennel
261 lines
9.6 KiB
Fennel
;; helper and utility functions
|
|
(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)
|
|
(each [_ row (ipairs board)]
|
|
(let [(row-template slots) (string.gsub row "x" "%%d")]
|
|
(if (> slots 0)
|
|
(do
|
|
(let [offset (+ index slots)
|
|
myslice (tbl.slice moves index offset)]
|
|
(print (string.format row-template (table.unpack myslice)))
|
|
(set index offset)))
|
|
(print row))))
|
|
(print (.. "Stage: " (str.capitalize (. (tbl.invert 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!")))
|
|
)
|
|
)
|
|
|
|
|
|
; get player input
|
|
(fn get-move []
|
|
(io.read))
|
|
|
|
|
|
(fn main []
|
|
;; game loop
|
|
(while (not (= game.stage 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))
|
|
(if (not is-valid)
|
|
(print "Try again.")
|
|
(do
|
|
(print (string.format "Turn %d: You chose %s" game.turns move))
|
|
(game:update move)))))
|
|
;; game is complete
|
|
(print "Congratulations!")
|
|
(print (string.format "Player %d is the winner!" game.player))
|
|
)
|
|
(main)
|