dozens
/
9mm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

🗄️ big tidy up 

- isolate core game logic and move it to src/game.fnl
- main.fnl should be just the ui now
- move all table funcs into lib/table
- move all (1) string funcs into lib/string
- move all game funcs into lib/game/
main
Dozens B. McCuzzins 2024-06-20 09:17:06 -06:00
parent ce09973e7c
commit c7b2c98200
38 changed files with 588 additions and 584 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
doc/tilde30.t
View File

@ -246,6 +246,31 @@ I've never used it before.
It's basically the "compose" or "pipe" function
that I have enjoyed using before in javascript.
up next: fix that bug!
.
.
.IP 18
Finished the game today!
(I think!)
Working on modularizing the core logic
and tidying up some of the libraries.
Up next: Story Mode.
.
.
.IP 19
Just did a bunch of tidying up.
Consolodated some libs.
(All table funs into a 'table' modules, e.g.)
Rewrote a couple of functions.
Sometimes using the threading macros
can replace a 'let' block
with a tighter pointfree composition
that I sometimes like.
My surgery is tomorrow.
After that I am going to be in a lot of pain /
on a lot of drugs,
and will be spending a lot of time on my back.
So I'm either going to get a lot on 9mm,
or nothing at all.
We'll see!
.pl \n[nl]u

9
justfile
View File

@ -4,7 +4,8 @@ default:
# run tests
test:
for f in lib/*.test.fnl; do fennel $f | faucet; done
#!/bin/zsh
for f in **/*.test.fnl; do fennel $f | faucet; done
# build expect scripts
expects:
@ -12,4 +13,8 @@ expects:
# make the project
project:
awk '$0 ~ /^---$/ && times++ < 2 { a=!a;next; } a' doc/tilde30.t | recfmt -f doc/tilde30.t | awk '$0 ~ /^---$/ { times++;next } times > 1' | nroff -ms -Tascii
awk '$0 ~ /^---$/ && times++ < 2 { a=!a;next; } a' doc/tilde30.t \
| recfmt -f doc/tilde30.t \
| awk '$0 ~ /^---$/ { times++;next } times > 1' \
| nroff -ms -Tascii \
| ssh tilde 'cat > .project'

14
lib/constants.fnl
View File

@ -84,8 +84,22 @@
"G x-----x-----x" ;; 22 23 24
])
;; 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
})
{: board
: mills
: neighbors
: stages
: spaces}

7
lib/contains.fnl
View File

@ -1,7 +0,0 @@
(fn contains [t x]
(accumulate [found false
_ v (ipairs t)
&until found] ; escape early
(or found (= x v))))
{: contains}

17
lib/contains.test.fnl
View File

@ -1,17 +0,0 @@
(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))))

72
lib/either.test.fnl
View File

@ -1,41 +1,33 @@
(let [{: pprint} (require :lib.tableprint)
{: describe :end test-end} (require :lib.test)
(let [{:print pprint} (require :lib.table)
{: describe : 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))))
(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
View File

@ -1,22 +0,0 @@
;; 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
View File

@ -1,28 +0,0 @@
(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))))

5
lib/game/README 100644
View File

@ -0,0 +1,5 @@
These are all game specific functions that are big and or complex enough that i
wanted to break them out into their own modules so i could test them.
when you add a function here, add a test file, and be sure to import/export it
to/from index.fnl

12
lib/all-mills.fnl → lib/game/all-mills.fnl
View File

@ -1,4 +1,4 @@
(local {: mill-at? } (require :lib.mill))
(local {: mill-at? } (require :lib.game.mill))
(local {: mills } (require :lib.constants))
(fn toggle-player [p] (if (= p 1) 2 1))
@ -6,16 +6,16 @@
(fn only-player-moves [moves player]
(icollect [_ move (ipairs moves)] (if (= move player) player 0)))
(fn all-moves-are-mills? [moves player]
(fn all-moves-are-mills? [player moves]
(accumulate [result true
i m (ipairs moves) ]
(and result (if (= m 0) true (mill-at? mills moves i)))))
(fn all-mills? [all-moves current-player]
(let [next-player (toggle-player current-player)
player-moves (only-player-moves all-moves next-player)
all-mills (all-moves-are-mills? player-moves current-player)]
all-mills))
(->> current-player
(toggle-player)
(only-player-moves all-moves)
(all-moves-are-mills? current-player)))
{: all-mills?
;; do not use; just for testing:

16
lib/all-mills.test.fnl → lib/game/all-mills.test.fnl
View File

@ -1,19 +1,19 @@
(let [{: describe
:end test-end} (require :lib.test)
: test-end} (require :lib.test)
{: all-mills?
: toggle-player
: only-player-moves
: all-moves-are-mills?
} (require :lib.all-mills)]
} (require :lib.game.all-mills)]
(describe "all-mills" (fn []
(describe "#toggle-player()" (fn [t]
(describe "# ALL-MILLS" (fn []
(describe "toggle-player()" (fn [t]
(t {:given "a player"
:should "return the next"
:expected 2
:actual (toggle-player 1)
})))
(describe "#only-player-moves()" (fn [t]
(describe "only-player-moves()" (fn [t]
(let [moves [ 0 2 0 2 2 2 0 0 0 0 0 0 0 2 0 0 0 2 0 2 0 1 1 1 ]
expected [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ]
]
@ -22,20 +22,20 @@
: expected
:actual (only-player-moves moves 1)
}))))
(describe "#all-moves-are-mills?()" (fn [t]
(describe "all-moves-are-mills?()" (fn [t]
(let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ]
]
(t {:given "a bunch of moves and a player"
:should "return true if all the player moves are mills"
:expected true
:actual (all-moves-are-mills? moves 1)
:actual (all-moves-are-mills? 1 moves)
}))
(let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 ]
]
(t {:given "a bunch of moves and no mill and a player"
:should "return false"
:expected false
:actual (all-moves-are-mills? moves 1)
:actual (all-moves-are-mills? 1 moves)
}))))
(test-end))))

11
lib/game/index.fnl 100644
View File

@ -0,0 +1,11 @@
(local {: all-mills?} (require :lib.game.all-mills))
(local {: mill-at?} (require :lib.game.mill))
(local {: space-is-neighbor?} (require :lib.game.space-is-neighbor))
(local {: no-moves?} (require :lib.game.no-moves))
{
: all-mills?
: mill-at?
: no-moves?
: space-is-neighbor?
}

16
lib/mill.fnl → lib/game/mill.fnl
View File

@ -1,8 +1,9 @@
(local {: contains} (require :lib.contains))
(local {: contains} (require :lib.table))
(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)))
(icollect [_ mill (ipairs all-mills)]
(if (contains mill next-move) mill)))
(fn any [t]
"take a list of booleans, returns true if any of them are true"
@ -17,7 +18,7 @@
_ m (ipairs moves)]
(and acc (not= m 0) (= player m))))))
(fn candidate-moves [candidates moves]
(fn candidate-moves [moves candidates]
"Just turning board spaces into player moves"
(icollect [_ spaces (ipairs candidates)]
(icollect [_ space (ipairs spaces)]
@ -25,11 +26,10 @@
(fn mill-at? [all-mills current-moves move]
"Is there a mill at this move?"
(let [candidates (get-candidates all-mills move)
my-moves (candidate-moves candidates current-moves)
my-mills (move-mills my-moves)
result (any my-mills)]
result))
(->> (get-candidates all-mills move)
(candidate-moves current-moves)
(move-mills)
(any)))
{: mill-at?
;; not for consumption,

85
lib/mill.test.fnl → lib/game/mill.test.fnl
View File

@ -1,21 +1,20 @@
(let [{: describe
:end test-end} (require :lib.test)
: test-end} (require :lib.test)
{: mill-at?
: get-candidates
: move-mills
: candidate-moves
: any
} (require :lib.mill)
} (require :lib.game.mill)
{: mills } (require :lib.constants)
with-mills (partial mill-at? mills)]
(describe "Mill" (fn []
(describe "#get-candidates()" (fn [t]
(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 ]
]
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
@ -24,13 +23,11 @@
(t
(let [move 1
expected [[1 2 3] [1 10 22]]
moves [ 0 0 0 ]
]
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)
}))
:actual (get-candidates mills move) }))
(t
(let [move 1
moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
@ -39,82 +36,62 @@
{:given (string.format "a move of %d" move)
:should "still return [[1 2 3] [1 10 22]]"
: expected
:actual (get-candidates mills move)
}))
))
:actual (get-candidates mills move) }))))
(describe "#any()" (fn [t]
(describe "any()" (fn [t]
(t {:given "a table of false false true"
:should "return true"
:expected true
:actual (any [false false true])
})
:actual (any [false false true]) })
(t {:given "a table of true false"
:should "return true"
:expected true
:actual (any [true false])
})
:actual (any [true false]) })
(t {:given "a single false"
:should "return false"
:expected false
:actual (any [false])
})
:actual (any [false]) })
(t {:given "a single true"
:should "return true"
:expected true
:actual (any [true])
})))
:actual (any [true]) })))
(describe "#move-mills()" (fn [t]
(describe "move-mills()" (fn [t]
(t
(let [moves [[1 1 1] [0 2 2]]
]
(let [moves [[1 1 1] [0 2 2]] ]
{:given "a list of moves"
:should "turn them into true/false if they are mills"
:expected [true false]
:actual (move-mills moves)
}))
:actual (move-mills moves) }))
(t
(let [moves [[0 1 1] [0 2 2]]
]
(let [moves [[0 1 1] [0 2 2]] ]
{:given "no mills"
:should "should return false"
:expected [false false]
:actual (move-mills moves)
}))
:actual (move-mills moves) }))
(t
(let [moves [[2 2 2] [2 0 0]]
]
(let [moves [[2 2 2] [2 0 0]] ]
{:given "mill, no mill"
:should "should return true false"
:expected [true false]
:actual (move-mills moves)
}))
))
:actual (move-mills moves) }))))
(describe "#candidate-moves()" (fn [t]
(describe "candidate-moves()" (fn [t]
(t (let [spaces [[1 2 3] [1 10 22]]
moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
]
moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ]
{:given "spaces [[1 2 3] [1 10 22]]"
:should "map to moves"
:expected [[2 2 2] [2 0 0]]
:actual (candidate-moves spaces moves)
}
)
)
))
:actual (candidate-moves moves spaces)}))))
(describe "#mill-at?()" (fn [t]
(describe "mill-at?()" (fn [t]
(t
(let [move 1
moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
]
moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ]
{:given "no mills"
:should "return false"
:expected false
:actual (mill-at? mills moves move)
}))
:actual (mill-at? mills moves move)}))
(t
(let [move 4
moves [1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
@ -123,8 +100,7 @@
{:given "a mill but not at Move"
:should "return false"
:expected false
:actual (with-moves move)
}))
:actual (with-moves move)}))
(t
(let [move 1
moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
@ -133,8 +109,7 @@
{:given "a mill"
:should "return true"
:expected true
:actual (with-moves move)
}))
:actual (with-moves move) }))
(t
(let [move 1
moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
@ -143,8 +118,6 @@
{:given "a mill"
:should "return the opposite of false"
:expected false
:actual (not (with-moves move))
}))
))
:actual (not (with-moves move)) }))))
(test-end))))

2
lib/no-moves.fnl → lib/game/no-moves.fnl
View File

@ -1,4 +1,4 @@
(local {: tail} (require :lib.tail))
(local {: tail} (require :lib.table))
(fn get-player-idxs [player moves]
(icollect [i p (ipairs moves)] (when (= p player) i)))

8
lib/no-moves.test.fnl → lib/game/no-moves.test.fnl
View File

@ -1,10 +1,10 @@
(let [{: no-moves?} (require :lib.no-moves)
(let [{: no-moves?} (require :lib.game.no-moves)
{: neighbors} (require :lib.constants)
{: describe :end test-end} (require :lib.test)
{: describe : test-end} (require :lib.test)
with-neighbors (partial no-moves? neighbors)
]
(describe "no-moves()" (fn [t]
(describe "# NOMOVES" (fn [t]
(let [moves [ 1 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 ]
player 1
]
@ -47,5 +47,3 @@
}))
(test-end))))

7
lib/space-is-neighbor.fnl → lib/game/space-is-neighbor.fnl
View File

@ -1,6 +1,7 @@
(local {: contains} (require :lib.contains))
(local {: head} (require :lib.head))
(local {: tail} (require :lib.tail))
(local {: contains
: head
: tail
} (require :lib.table))
(lambda space-is-neighbor? [all-neighbors from to]
;; i have learned to check that i'm passing the correct type of move

10
lib/space-is-neighbor.test.fnl → lib/game/space-is-neighbor.test.fnl
View File

@ -1,10 +1,9 @@
(let [{: space-is-neighbor?} (require :lib.space-is-neighbor)
(let [{: space-is-neighbor?} (require :lib.game.space-is-neighbor)
{: neighbors} (require :lib.constants)
{: describe :end test-end} (require :lib.test)
with-neighbors (partial space-is-neighbor? neighbors)
]
{: describe : test-end} (require :lib.test)
with-neighbors (partial space-is-neighbor? neighbors) ]
(describe "space-is-neighbor()" (fn [t]
(describe "# SPACE-IS-NEIGHBOR" (fn [t]
(t {:given "space of 3"
:should "know 2 is a neighbor"
:expected true
@ -19,4 +18,3 @@
:actual (with-neighbors 3 1)})
(test-end))))

6
lib/head.fnl
View File

@ -1,6 +0,0 @@
; return the first item in a table
(fn head [t] (if (> (length t) 0)
(?. t 1)
[]))
{: head}

12
lib/head.test.fnl
View File

@ -1,12 +0,0 @@
(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))))

8
lib/index.fnl
View File

@ -1,15 +1,7 @@
(local str (require :lib.string))
(local tbl (require :lib.table))
(local {: all-mills?} (require :lib.all-mills))
(local {: mill-at?} (require :lib.mill))
(local {: space-is-neighbor?} (require :lib.space-is-neighbor))
(local {: no-moves?} (require :lib.no-moves))
{
: str
: tbl
: all-mills?
: mill-at?
: no-moves?
: space-is-neighbor?
}

7
lib/keys.fnl
View File

@ -1,7 +0,0 @@
(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
View File

@ -1,13 +0,0 @@
(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)))))

6
lib/kvflip.fnl
View File

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

13
lib/kvflip.test.fnl
View File

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

5
lib/slice.fnl
View File

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

19
lib/slice.test.fnl
View File

@ -1,19 +0,0 @@
(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))))

2
lib/string.fnl
View File

@ -1,3 +1,5 @@
;; string funs
(fn capitalize [s]
(.. (string.upper (string.sub s 1 1)) (string.sub s 2)))

13
lib/string.test.fnl 100644
View File

@ -0,0 +1,13 @@
(let [{: capitalize
} (require :lib.string)
{: describe
: test-end} (require :lib.test)]
(describe "# STRING" (fn []
(describe "capitalize()" (fn [t]
(t {:given "a string"
:should "capitalize it"
:expected :Giraffe
:actual (capitalize :giraffe)})))
(test-end))))

50
lib/table.fnl
View File

@ -1,16 +1,50 @@
(local {: contains} (require :lib.contains))
(local {: head} (require :lib.head))
(local {: keys} (require :lib.keys))
(local {:kvflip invert} (require :lib.kvflip))
(local {:pprint print} (require :lib.tableprint))
(local {: slice} (require :lib.slice))
(local {: tail} (require :lib.tail))
;; table funs
(fn contains [t x]
"does table t contain element x?"
(accumulate [found false
_ v (ipairs t)
&until found] ; escape early
(or found (= x v))))
(fn head [t]
"return the first item in a table"
(if (> (length t) 0)
(?. t 1)
[]))
(fn tail [t]
"return the table minus the head"
(icollect [i v (ipairs t)]
(if (> i 1)
v)))
(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)
(fn flip [t]
"takes a table of {key value} and returns a table of {value key}"
(collect [k v (pairs t)] (values v k)))
(fn print [tbl]
"print a table"
(each [k v (pairs tbl)]
(let [table? (= (type v) :table)]
(print k v))))
(fn slice [t start stop]
"return a slice of a table"
(fcollect [i start (or stop (length t))]
(. t i)))
{
: contains
: flip
: head
: keys
: invert
: print
: slice
: tail

80
lib/table.test.fnl 100644
View File

@ -0,0 +1,80 @@
(let [{: contains
: flip
: head
: keys
: slice
: tail
} (require :lib.table)
{: describe
: test-end} (require :lib.test)]
(describe "# TABLE" (fn []
(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)})))
(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)}))))
(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 []))})))
(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}))))
(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)}))))
(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))))

7
lib/tableprint.fnl
View File

@ -1,7 +0,0 @@
; print a table
(fn pprint [tbl]
(each [k v (pairs tbl)]
(let [table? (= (type v) :table)]
(print k v))))
{: pprint}

7
lib/tail.fnl
View File

@ -1,7 +0,0 @@
; return the table minus the head
(fn tail [t]
(icollect [i v (ipairs t)]
(if (> i 1)
v)))
{: tail}

19
lib/tail.test.fnl
View File

@ -1,19 +0,0 @@
(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))))

42
lib/test.fnl
View File

@ -1,5 +1,25 @@
(local {: pprint} (require :lib.tableprint))
(local {: equal} (require :lib.equal))
(local {:print pprint} (require :lib.table))
;; 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)
(var plan 0)
@ -13,7 +33,7 @@
(fn test [obj]
(let [{: given : should : actual : expected} obj
ok (if (equal actual expected) :ok "not ok")
ok (if (deep-equals actual expected) :ok "not ok")
description (.. "Given " given " should " should)
]
(set plan (+ 1 plan))
@ -38,15 +58,15 @@
(local print-header (once (fn [] (print "TAP version 14"))))
(fn desc [str cb]
(fn describe [str cb]
(print-header)
(print (.. "#" str))
(cb test)
)
(fn end []
(print (.. 1 ".." plan))
)
(cb test))
(fn test-end []
(print (.. 1 ".." plan)))
{:describe desc
: end}
{: describe
: deep-equals
: test-end}

70
lib/test.test.fnl
View File

@ -1,19 +1,53 @@
(let [{: describe :end test-end} (require :lib.test)]
(let [{: describe
: test-end
: deep-equals
} (require :lib.test)]
;; just a little something to test with
(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))))
y (or y 0)]
(+ x y)))
(describe "# TEST" (fn []
(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}))))
(describe "equal()" (fn [t]
(t {:given "two equal tables"
:should "return true"
:expected true
:actual (deep-equals [:orange :apple :pear] [:orange :apple :pear]) })
(t {:given "two different tables"
:should "return false"
:expected false
:actual (deep-equals [:apple :pear] [:orange :apple :pear]) })
(t {:given "equal strings"
:should "be true"
:expected true
:actual (deep-equals :apple :apple) })
(t {:given "different strings"
:should "be false"
:expected false
:actual (deep-equals :apple :pear) })
(t {:given "equal bools"
:should "be true"
:expected true
:actual (deep-equals true true) })
(t {:given "different strings"
:should "be false"
:expected false
:actual (deep-equals true false) })))
(test-end))))

221
main.fnl
View File

@ -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,84 +19,12 @@
(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!")))
)
)
; get player input
(fn get-move []
(io.read))
@ -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)

204
src/game.fnl 100644
View File

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