diff options
Diffstat (limited to 'main.fnl')
| -rw-r--r-- | main.fnl | 236 |
1 files changed, 65 insertions, 171 deletions
diff --git a/main.fnl b/main.fnl index 169f4f9..d9ec3b4 100644 --- a/main.fnl +++ b/main.fnl @@ -1,41 +1,16 @@ -; Introducing: -; Nine Mens Morris -; The Game -; -; Featuring: -; Fennel -; The Language -; -; By: -; dozens -; the human -; -; Do you know what Nine Mens Morris looks like? -; It has three concentric rings, each containing eight spaces. -; Here's what it looks like: -; -; 1-----2-----3 -; | | | -; | 4---5---6 | -; | | | | | -; | | 7-8-9 | | -; | | | | | | -; 0-1-2 3-4-5 +10 -; | | | | | | -; | | 6-7-8 | | -; | | | | | -; | 9---0---1 | +20 -; | | | -; 2-----3-----4 - - ;; helper and utility functions (local { - :contains contains - :head head + : contains + : head + : flip + : pprint + : slice :mill? mill-maker - :pprint pprint } (require :lib.index)) +;; constants...more like just strings +(local const (require :lib.constants)) +;; front-loading mill with a partial +(local mill? (partial mill-maker const.mills)) ; there are three phases of play: @@ -43,19 +18,19 @@ ; (plus one for capturing) ; (plus one for complete) (local stages { - :placing 1 - :moving 2 - :flying 3 - :capture 4 - :complete 5 + :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 - :two 2 ;; mario + :one 1 ;; luigi has light cows + :two 2 ;; mario has DARK cows >:) }) @@ -68,67 +43,14 @@ (local moves (fcollect [i 1 24] 0)) -(local rules { -; what moves are legal from each space -; slash what neighbors does each space have - :neighbors [ - [1 2 10] - [2 1 3 5] - [3 2 15] - [4 5 11] - [5 2 4 6 8] - [6 5 14] - [7 8 12] - [8 5 7 9] - [9 8 13] - [10 1 11 22] - [11 4 10 12 19] - [12 7 11 16] - [13 9 14 18] - [14 6 13 15 21] - [15 3 14 24] - [16 12 17] - [17 16 18 20] - [18 13 17] - [19 11 20] - [20 17 19 21 23] - [21 14 20] - [22 10 23] - [23 20 22 24] - [24 15 23] - ] -; sixteen combinations of spaces form a mill - :mills [ - [1 2 3] - [4 5 6] - [7 8 9] - [10 11 12] - [13 14 15] - [16 17 18] - [19 20 21] - [22 23 24] - [1 10 22] - [4 11 19] - [7 12 16] - [2 5 8] - [17 20 23] - [9 13 18] - [6 14 21] - [3 15 24] - ] -}) - -(fn mill? [state move] (partial mill-maker rules.mills)) - - ; game state object (local game { :player player.one :stage stages.placing :update (fn [self move] - (if (mill? moves move) + (if (mill? moves move self.player) (do - (print "MILLLLLLLLLLLLL!") + (print "Mooooooo") (tset self :stage stages.capture) ) (tset self :player (if (= player.one self.player) player.two player.one)) @@ -137,93 +59,59 @@ }) - - - -; This is what the game board looks like -; it's also used to display the state of the game -; the Xs are converted to "%d" later for string templating -; they are Xs here so that it looks pretty =) -(local board [ - " 1 2 3 4 5 6 7" - "A x-----x-----x" - " | | |" - "B | x---x---x |" - " | | | | |" - "C | | x-x-x | |" - " | | | | | |" - "D x-x-x x-x-x" - " | | | | | |" - "E | | x-x-x | |" - " | | | | |" - "F | x---x---x |" - " | | |" - "G x-----x-----x" -]) - - +(fn string-upper [s] + (.. (string.upper (string.sub s 1 1)) (string.sub s 2))) ; Print! That! Board! (fn print-board [board moves] - (var total-count -2) ; lol, m-a-g-i-c - ; just kidding, it's so that -2 + 3 = 1 - ; which is where i want to start indexing my table + (var index 1) (each [_ row (ipairs board)] - (let [(template count) (string.gsub row "x" "%%d")] - (if (> count 0) + (let [(row-template slots) (string.gsub row "x" "%%d")] + (if (> slots 0) (do - (set total-count (+ total-count count)) ; where i need that magic number on first iteration - (print (string.format template (select total-count (table.unpack moves))))) - (print row))))) -; `select` above does NOT do what i thought it did. -; i thought it would return the first x values given (select x values) -; instead it returns the rest of the table having discarded the first x values -; i think that `pick-values` probably does what i thought `select` does + (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:"))) -; these are the only moves that are valid -; i am somewhat bothered by all the wasted space -; by 2-3A and 5-6A e.g. -; Incidentally these are all in order of appearance -; so when you find a match, -; you can also update that index of `moves` to the current player number -(local valid-spaces [ - "1A" "4A" "7A" - "2B" "4B" "6B" - "3C" "4C" "5C" - "1D" "2D" "3D" - "5D" "6D" "7D" - "3E" "4E" "5E" - "2F" "4F" "5F" - "1G" "4G" "7G" -]) ; add the inverse of each valid move ; e.g. 1A = A1 (fn add-reverse-moves [] - (let [reversed (icollect [_ v (ipairs valid-spaces)] (string.reverse v))] + (let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))] (each [_ v (ipairs reversed)] - (table.insert valid-spaces v)))) + (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 valid-spaces (string.upper m))) +(fn space-exists? [m] (contains const.spaces (string.upper m))) + -; return the numerical index of a "A1" formatted move +; 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 valid-spaces)] - (if (or (= v upper) (= v rev)) i))) - ] + (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 move ("A1") unoccupied? +; is the space represented by a [A-Za-z0-9] move unoccupied? (fn space-is-unoccupied? [m] - (let [unoccupied? 0] + (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)] + (= opponent (. moves (index-of-move m))))) + + + ; is this a legal move? ; TODO: maybe some functional error handling here? ; https://mostly-adequate.gitbook.io/mostly-adequate-guide/ch08#pure-error-handling @@ -237,30 +125,34 @@ (or (and (= stages.placing game.stage) - (or (space-exists? move) (print "That space does not exist!\nHint: 1a 1A A1 a1 are all valid moves.")) - (or (space-is-unoccupied? move) (print "That space is occupied!")))) + (or (space-exists? move) + (print "That space does not exist!\nHint: 1a 1A A1 a1 are all equal moves.")) + (or (space-is-unoccupied? move) + (print "That space is occupied!"))) (and ;; TODO: add capturing phase (= stages.capturing game.stage) + (or (space-is-occupied-by-opponent? move) + (print "Choose an opponent's piece to remove.")) ) (and ;; TODO: add flying phase (= stages.flying game.stage) ) + ) ) ; get player input (fn get-move [] - (print (.. "Player " game.player "'s turn:")) (io.read)) (fn main [] ;; game loop (while (not (= game.stage stages.complete)) - (print-board board moves) + (print-board const.board moves) ;; validation loop (var is-valid false) @@ -268,14 +160,16 @@ (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)) - (tset moves (index-of-move move) game.player) - (game:update 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) + ) ) - ) + ) ) ) ) |