From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 22 Jun 2017 19:39:07 +0000 (+0200)
Subject: add board variations
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=0bb23bf143d94910e6ece4fddc616c008671d18d;p=cleanpeg.git

add board variations
---

diff --git a/peg.icl b/peg.icl
index 2519f69..8efcd4b 100644
--- a/peg.icl
+++ b/peg.icl
@@ -27,12 +27,12 @@ W :== 3
 
 :: Coord = {x::Int, y::Int}
 :: Move = {c::Coord, d::Direction}
-:: PegBoard :== {{#Position}}
+:: PegBoard :== {#{#Position}}
 
 :: Solver a :== RWST () [PegBoard] PegBoard Maybe a
 
-european :: PegBoard
-european = 
+english :: PegBoard
+english = 
 	{{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
 	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
 	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
@@ -42,6 +42,55 @@ european =
 	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
 	}
 
+french :: PegBoard
+french = 
+	{{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	,{Inv, Peg, Peg, Peg, Peg, Peg, Inv}
+	,{Peg, Peg, Peg, Emp, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Inv, Peg, Peg, Peg, Peg, Peg, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	}
+
+german :: PegBoard
+german = 
+	{{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	}
+
+bell :: PegBoard
+bell = 
+	{{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	}
+
+diamond :: PegBoard
+diamond = 
+	{{Inv, Inv, Inv, Inv, Peg, Inv, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Peg, Peg, Inv, Inv}
+	,{Inv, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Inv}
+	,{Peg, Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
+	,{Inv, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Peg, Peg, Inv, Inv}
+	,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
+	,{Inv, Inv, Inv, Inv, Peg, Inv, Inv, Inv, Inv}
+	}
+
 empty = RWST \_ _->Nothing
 (<|>) (RWST fa) (RWST fb) = RWST \r s->maybe (fb r s) Just (fa r s)
 
@@ -71,7 +120,7 @@ win :: (PegBoard -> Bool)
 win = (==) 1 o length o getCoords ((==)Peg)
 
 printPegBoard :: PegBoard -> String
-printPegBoard b = 'Text'.join "\n" [r\\r <-: b]
+printPegBoard b = 'Text'.join "\n" $ ["\n":[r\\r <-: b]] ++ ["\n"]
 
 moves :: Solver [Move]
 moves = gets $ \b->[{c=c,d=d}\\c<-getCoords ((==)Emp) b, d<-[N,E,S,W]]
@@ -83,4 +132,4 @@ where
 		(get >>= tell o pure)
 		(moves >>= foldr (<|>) empty o map (\m->move m >>| solver))
 
-Start = 'Text'.join "\n" o map printPegBoard <$> solve european
+Start = [map printPegBoard <$> solve b\\b<-[english,german,french,bell, diamond]]