add board variations

diff --git a/peg.icl b/peg.icl
index 2519f69..8efcd4b 100644 (file)
--- 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]]