summaryrefslogtreecommitdiff
path: root/lib/mill.fnl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/mill.fnl')
-rw-r--r--lib/mill.fnl57
1 files changed, 43 insertions, 14 deletions
diff --git a/lib/mill.fnl b/lib/mill.fnl
index de54128..e3b3337 100644
--- a/lib/mill.fnl
+++ b/lib/mill.fnl
@@ -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
+ }