main
Dozens B. McCuzzins 2024-05-29 19:26:41 -06:00
parent f265d24c0c
commit 7c07d6e6ec
21 changed files with 686 additions and 258 deletions

51
doc/README.md 100644
View File

@ -0,0 +1,51 @@
# 9mm
Introducing:
Nine Mens Morris
The Game
A game about moving cows
Featuring:
Fennel
The Language
By:
dozens
the human
## ABOUT
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
```
## BACKGROUND
9mm is legit a great game.
One time i wrote an essay about the social contract implicit to nine mens morris:
https://write.tildeverse.org/dozens/nine-mens-morris-cultural-meanings-and-social-contracts
Kind of obsessed with this variation about COWS
https://en.wikipedia.org/wiki/Morabaraba
also look at these round cows
https://en.wikipedia.org/wiki/Spherical_cow

7
justfile 100644
View File

@ -0,0 +1,7 @@
# list available recipes
default:
just --list --unsorted
# run tests
test:
for f in lib/*.test.fnl; do fennel $f | faucet; done

91
lib/constants.fnl 100644
View File

@ -0,0 +1,91 @@
(local 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]
])
(local 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]
])
; 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 spaces [
"1A" "4A" "7A"
"2B" "4B" "6B"
"3C" "4C" "5C"
"1D" "2D" "3D"
"5D" "6D" "7D"
"3E" "4E" "5E"
"2F" "4F" "6F"
"1G" "4G" "7G"
])
; 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" ;; 1 2 3
" | | |" ;;
"B | x---x---x |" ;; 4 5 6
" | | | | |" ;;
"C | | x-x-x | |" ;; 7 8 9
" | | | | | |" ;;
"D x-x-x x-x-x" ;; 10 11 12 13 14 15
" | | | | | |" ;;
"E | | x-x-x | |" ;; 16 17 18
" | | | | |" ;;
"F | x---x---x |" ;; 19 20 21
" | | |" ;;
"G x-----x-----x" ;; 22 23 24
])
{: board
: mills
: neighbors
: spaces}

View File

@ -1,11 +1,17 @@
(let [{: contains } (require :lib.contains)]
(let [given "a list and an element it contains"
should "returns true"
expected true
actual (contains [:apple :orange :pear] :apple)]
(assert (= actual expected) (.. "Given " given " should " should)))
(let [given "a list and an element it does not contain"
should "returns false"
expected false
actual (contains [:apple :orange :pear] :gorilla)]
(assert (= actual expected) (.. "Given " given " should " should))))
(let [{: contains } (require :lib.contains)
{: describe } (require :lib.test)
{: describe :end test-end} (require :lib.test)
]
(describe "contains()" (fn [t]
(t {:given "a list and an element it contains"
:should "returns true"
:expected true
:actual (contains [:apple :orange :pear] :apple)}
)
(t {:given "a list and an element it does not contain"
:should "returns false"
:expected false
:actual (contains [:apple :orange :pear] :gorilla)
})
(test-end))))

View File

@ -1,40 +1,41 @@
(local {: pprint} (require :lib.tableprint))
(let [{
: Either
: Left
: Right
} (require :lib.either)]
;; either
;(print "Either Inspection")
;(pprint Either)
;; you can set and get values
(let [ v :poop x (Either:new v)]
(assert (= v x.value) (.. "The value is " v)))
(let [r (Right:new "rain")
map (r:map #(.. "b" $1))
expected :brain
actual (. map :value)
]
(assert (= expected actual) "You can map a Right value"))
(let [l (Left:new "rain")
map (l:map #(.. "b" $1))
expected :rain
actual (. map :value)
]
(assert (= expected actual) "You can NOT map a Left value"))
(let [e (Either.of "rank")
map (e:map #(.. "f" $1))
expected :frank
actual (. map :value)
]
(assert (= expected actual) "You can map a Either.of"))
)
(let [{: pprint} (require :lib.tableprint)
{: describe :end test-end} (require :lib.test)
{: Either : Left : Right } (require :lib.either)]
(describe "Either" (fn [t]
(t {:given "a new either"
:should "set its value correctly"
:expected :poop
:actual (. (Either:new :poop) :value)
})
(t
(let [r (Right:new "rain")
map (r:map #(.. "b" $1))
expected :brain
actual (. map :value)]
{:given "a Right of some value"
:should "map"
expected
actual
}))
(t
(let [ l (Left:new "rain")
map (l:map #(.. "b" $1))
expected :rain
actual (. map :value)
]
{:given "a Left of some value"
:should "not map"
expected
actual
}))
(t
(let [ e (Either.of "rank")
map (e:map #(.. "f" $1))
expected :frank
actual (. map :value) ]
{:given "Either.of"
:should "map"
expected
actual
}))
(test-end))))

22
lib/equal.fnl 100644
View File

@ -0,0 +1,22 @@
;; thanks:
;; https://gist.github.com/sapphyrus/fd9aeb871e3ce966cc4b0b969f62f539
;; and antifennel
(fn deep-equals [o1 o2 ignore-mt]
(when (= o1 o2) (lua "return true"))
(local o1-type (type o1))
(local o2-type (type o2))
(when (not= o1-type o2-type) (lua "return false"))
(when (not= o1-type :table) (lua "return false"))
(when (not ignore-mt)
(local mt1 (getmetatable o1))
(when (and mt1 mt1.__eq)
(let [___antifnl_rtn_1___ (= o1 o2)] (lua "return ___antifnl_rtn_1___"))))
(each [key1 value1 (pairs o1)]
(local value2 (. o2 key1))
(when (or (= value2 nil) (= (deep-equals value1 value2 ignore-mt) false))
(lua "return false")))
(each [key2 _ (pairs o2)]
(when (= (. o1 key2) nil) (lua "return false")))
true)
{:equal deep-equals}

28
lib/equal.test.fnl 100644
View File

@ -0,0 +1,28 @@
(let [{: equal} (require :lib.equal)
{: describe :end test-end} (require :lib.test)]
(describe "equal()" (fn [t]
(t {:given "two equal tables"
:should "return true"
:expected true
:actual (equal [:orange :apple :pear] [:orange :apple :pear]) })
(t {:given "two different tables"
:should "return false"
:expected false
:actual (equal [:apple :pear] [:orange :apple :pear]) })
(t {:given "equal strings"
:should "be true"
:expected true
:actual (equal :apple :apple) })
(t {:given "different strings"
:should "be false"
:expected false
:actual (equal :apple :pear) })
(t {:given "equal bools"
:should "be true"
:expected true
:actual (equal true true) })
(t {:given "different strings"
:should "be false"
:expected false
:actual (equal true false) })
(test-end))))

6
lib/flip.fnl 100644
View File

@ -0,0 +1,6 @@
(fn flip [t]
"takes a table of {key value} and returns a table of {value key}"
(collect [k v (pairs t)] (values v k)))
{: flip}

13
lib/flip.test.fnl 100644
View File

@ -0,0 +1,13 @@
(let [{: flip} (require :lib.flip)
{: describe :end test-end} (require :lib.test)]
(describe "flip()" (fn [t]
(let [input {:apple "red" :banana "yellow"}
expected {:red "apple" :yellow "banana"}
]
(t {:given "a table"
:should "flip that table!"
: expected
:actual (flip input)})
(test-end)))))

View File

@ -1,11 +1,12 @@
(let [{: head } (require :lib.head)]
(let [given "a lift of elements"
it "returns the first element of a list"
expected :apple
actual (head [:apple :orange :pear])]
(assert (= actual expected) (.. "Given " given " it " it)))
(let [given "an empty list"
it "returns an empty list"
expected 0
actual (length (head []))]
(assert (= actual expected) (.. "Given " given " it " it))))
(let [{: head} (require :lib.head)
{: describe :end test-end} (require :lib.test)]
(describe "head()" (fn [t]
(t {:given "a list of elements"
:should "returns the first element of a list"
:expected :apple
:actual (head [:apple :orange :pear])})
(t {:given "an empty list"
:should "returns an empty list"
:expected 0
:actual (length (head []))})
(test-end))))

View File

@ -1,13 +1,19 @@
(local {:contains contains} (require :lib.contains))
(local {:head head} (require :lib.head))
(local {:mill? mill?} (require :lib.mill))
(local {:pprint pprint} (require :lib.tableprint))
(local {:tail tail} (require :lib.tail))
(local {: contains} (require :lib.contains))
(local {: flip} (require :lib.flip))
(local {: head} (require :lib.head))
(local {: keys} (require :lib.keys))
(local {: mill?} (require :lib.mill))
(local {: pprint} (require :lib.tableprint))
(local {: slice} (require :lib.slice))
(local {: tail} (require :lib.tail))
{
:contains contains
:head head
:mill? mill?
:pprint pprint
:tail tail
: contains
: flip
: head
: keys
: mill?
: pprint
: slice
: tail
}

7
lib/keys.fnl 100644
View File

@ -0,0 +1,7 @@
(fn keys [t]
"takes a table returns a sequential list of its keys"
(local out [])
(each [k v (pairs t)] (table.insert out k))
out)
{: keys}

13
lib/keys.test.fnl 100644
View File

@ -0,0 +1,13 @@
(let [{: keys} (require :lib.keys)
{: describe :end test-end} (require :lib.test)]
(describe "keys()" (fn [t]
(let [input {:apple :red :banana :yellow}
actual (keys input)
sorted (table.sort actual) ;; SIDE EFFECT!!
]
(t {:given "a table"
:should "returns a list of keys"
:expected [:apple :banana]
: actual})
(test-end)))))

View File

@ -1,16 +1,45 @@
(local {: contains} (require :lib.contains))
;; Does this move result in a mill?
(fn mill? [rules state move]
(let [candidates (icollect [_ mill (ipairs rules)] (if (contains mill move) mill))
candidate->moves (icollect [_ spaces (ipairs candidates)]
(icollect [_ space (ipairs spaces)] (. state space)) )
candidate-mill? (icollect [_ moves (ipairs candidate->moves)]
(accumulate [acc true
idx m (ipairs moves)]
(and acc (not= 0 m) (= (. moves idx) m)))) ]
(accumulate [acc true
_ x (ipairs candidate-mill?)]
(and acc x))))
{: mill?}
(fn get-candidates [all-mills next-move]
"a list of mills that contain next-move"
(icollect [_ mill (ipairs all-mills)] (if (contains mill next-move) mill)))
(fn candidates->moves [candidates current-moves move player]
"a list of the candidate mills expressed as current moves"
(icollect [_ spaces (ipairs candidates)]
(icollect [_ space (ipairs spaces)]
(if (= space move) :x (. current-moves space)))))
(fn moves->mills [spaces player]
"a list of bools if the candidate moves + player are all the same"
(let [next-move (icollect [_ y (ipairs spaces)]
(icollect [_ x (ipairs y)]
(if (= x :x) player x))) ]
(icollect [_ move (ipairs next-move)]
(accumulate [acc true
idx m (ipairs move)]
(and acc (= player m))))))
(fn any [t]
(accumulate [acc false
i x (ipairs t)]
(or acc x)))
(fn mill? [all-mills current-moves next-move player]
"Does the current move for the current player create a mill?"
(let [candidates (get-candidates all-mills next-move)
moves (candidates->moves candidates current-moves next-move player)
mills (moves->mills moves player)
result (any mills)]
result))
{: mill?
;; not for consumption,
;; just for testing:
: get-candidates
: candidates->moves
: moves->mills
: any
}

View File

@ -1 +1,141 @@
;; TODO: test me
(let [{: describe
:end test-end} (require :lib.test)
{: mill?
: get-candidates
: candidates->moves
: moves->mills
: any
} (require :lib.mill)
{: mills } (require :lib.constants)
with-mills (partial mill? mills)]
(describe "Mill" (fn []
(describe "#get-candidates()" (fn [t]
(t
(let [move 3
expected [[1 2 3] [3 15 24]]
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
]
{:given (string.format "a move of %d" move)
:should "return [[1 2 3] [3 15 24]]"
: expected
:actual (get-candidates mills move)
}))
(t
(let [move 1
expected [[1 2 3] [1 10 22]]
moves [ 0 0 0 ]
]
{:given (string.format "a move of %d" move)
:should "return [[1 2 3] [1 10 22]]"
: expected
:actual (get-candidates mills move)
}))))
(describe "#candidates->moves()" (fn [t]
(t
(let [candidates [[1 2 3] [1 10 22]]
moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2]
expected [[:x 1 1] [:x 2 2]]
move 1
player 2
]
{:given "a list of spaces and of current moves"
:should "return a map of spaces to moves"
: expected
:actual (candidates->moves candidates moves move player)
}))
(t
(let [candidates [[1 2 3] [3 15 24]]
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
expected [[1 1 :x] [:x 0 0]]
move 3
player 1
]
{:given "a list of candidates and of current moves"
:should "return an x-map of spaces to moves"
: expected
:actual (candidates->moves candidates moves move player)
}))))
(describe "#moves->mills()" (fn [t]
(t
(let [spaces [[:x 1 1] [:x 2 2]]
moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2]
player 2
]
{:given "a list of spaces and of current moves"
:should "return a map of spaces to moves"
:expected [false true]
:actual (moves->mills spaces player)
}))
(t
(let [spaces [[1 1 :x] [:x 0 0]]
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
player 1
]
{:given "a list of canditate-moves and of current moves"
:should "return a map of spaces to moves"
:expected [true false]
:actual (moves->mills spaces player)
}))))
(describe "#any()" (fn [t]
(t {:given "a table of false false true"
:should "return true"
:expected true
:actual (any [false false true])
})
(t {:given "a table of true false"
:should "return true"
:expected true
:actual (any [true false])
})
(t {:given "a single false"
:should "return false"
:expected false
:actual (any [false])
})
(t {:given "a single true"
:should "return true"
:expected true
:actual (any [true])
})))
(describe "#mill?()" (fn [t]
(t
(let [move 1
player 1
moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
with-moves (partial with-mills moves)]
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
:should "not be a mill"
:expected false
:actual (with-moves move player)
}))
(t
(let [move 3
player 1
moves [1 1 0]
with-moves (partial with-mills moves)]
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
:should "be a mill"
:expected true
:actual (with-moves move player)
}))
(t
(let [move 3
player 1
moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]
with-moves (partial with-mills moves)]
{:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ","))
:should "be a mill"
:expected true
:actual (with-moves move player)
}))))
(test-end))))

5
lib/slice.fnl 100644
View File

@ -0,0 +1,5 @@
(fn slice [t start stop]
(fcollect [i start (or stop (length t))]
(. t i)))
{: slice}

19
lib/slice.test.fnl 100644
View File

@ -0,0 +1,19 @@
(let [{: slice} (require :lib.slice)
{: describe :end test-end} (require :lib.test)]
(describe "slice()" (fn [t]
(t
(let [t [:apple :orange :pear :banana :strawberry]
]
{:given "a list of elements and a start"
:should "return the list starting at start"
:expected [:orange :pear :banana :strawberry]
:actual (slice t 2)}))
(t
(let [t [:apple :orange :pear :banana :strawberry]
]
{:given "a list of elements and a start and a stop"
:should "return the items between the two"
:expected [:orange :pear]
:actual (slice t 2 3)}))
(test-end))))

View File

@ -1 +1,19 @@
;; TODO: test me
(let [{: tail} (require :lib.tail)
{: describe :end test-end} (require :lib.test)]
(describe "tail()" (fn [t]
(t {:given "a list"
:should "return it minus the head"
:expected [:apple :pear]
:actual (tail [:orange :apple :pear])
})
(t {:given "a single item list"
:should "return empty list"
:expected []
:actual (tail [:orange])
})
(t {:given "an empty list"
:should "return empty list"
:expected []
:actual (tail [])
})
(test-end))))

52
lib/test.fnl 100644
View File

@ -0,0 +1,52 @@
(local {: pprint} (require :lib.tableprint))
(local {: equal} (require :lib.equal))
(var plan 0)
(fn once [funky]
(var bang false)
(fn [...]
(if (not bang)
(do
(funky ...)
(set bang true)))))
(fn test [obj]
(let [{: given : should : actual : expected} obj
ok (if (equal actual expected) :ok "not ok")
description (.. "Given " given " should " should)
]
(set plan (+ 1 plan))
(print (.. ok " " plan " - " description))
(if (= "not ok" ok)
(do
(print " ---")
(if (= :table (type expected))
(do
(print (.. " expected: " ))
(pprint expected))
(print (.. " expected: " (tostring expected))))
(if (= :table (type actual))
(do
(print (.. " actual: " ))
(pprint actual))
(print (.. " actual: " (tostring actual))))
(print " ...")
)
)
))
(local print-header (once (fn [] (print "TAP version 14"))))
(fn desc [str cb]
(print-header)
(print (.. "#" str))
(cb test)
)
(fn end []
(print (.. 1 ".." plan))
)
{:describe desc
: end}

19
lib/test.test.fnl 100644
View File

@ -0,0 +1,19 @@
(let [{: describe :end test-end} (require :lib.test)]
(fn add [x y] (let [x (or x 0)
y (or y 0)]
(+ x y)))
(describe "add()" (fn [test]
(let [should "return the right number"]
(test {:given "two numbers"
: should
:actual (add 2 3)
:expected 5})
(test {:given "no arguments"
:should "return 0"
:actual (add)
:expected 0})
(test {:given "zero"
: should
:actual (add 0 4)
:expected 4}))
(test-end))))

236
main.fnl
View File

@ -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)
)
)
)
)
)
)
)