module Main where
import Data.List.Split (chunksOf)
import Data.Array
data Checkers = B | P | V | F deriving Checkers -> Checkers -> Bool
(Checkers -> Checkers -> Bool)
-> (Checkers -> Checkers -> Bool) -> Eq Checkers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Checkers -> Checkers -> Bool
$c/= :: Checkers -> Checkers -> Bool
== :: Checkers -> Checkers -> Bool
$c== :: Checkers -> Checkers -> Bool
Eq
instance Show Checkers where
show :: Checkers -> String
show B = "⚪"
show P = "⚫"
show V = "⬜"
show F = ""
data Board a = Board { Board a -> (Int, Int)
foco :: (Int, Int)
, Board a -> Array (Int, Int) a
board :: Array (Int, Int) a
} deriving Board a -> Board a -> Bool
(Board a -> Board a -> Bool)
-> (Board a -> Board a -> Bool) -> Eq (Board a)
forall a. Eq a => Board a -> Board a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Board a -> Board a -> Bool
$c/= :: forall a. Eq a => Board a -> Board a -> Bool
== :: Board a -> Board a -> Bool
$c== :: forall a. Eq a => Board a -> Board a -> Bool
Eq
instance Show a => Show (Board a) where
show :: Board a -> String
show (Board _ board :: Array (Int, Int) a
board) = [String] -> String
unlines
([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([a] -> String) -> [[a]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show)
([[a]] -> [String]) -> [[a]] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall e. Int -> [e] -> [[e]]
chunksOf 8
([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) a -> [a]
forall i e. Array i e -> [e]
elems Array (Int, Int) a
board
type CoordFun = (Int, Int) -> (Int, Int)
type Movimento = [((Int,Int), Checkers)]
initialBoard :: Board Checkers
initialBoard :: Board Checkers
initialBoard = (Int, Int) -> Array (Int, Int) Checkers -> Board Checkers
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (1,1) (Array (Int, Int) Checkers -> Board Checkers)
-> Array (Int, Int) Checkers -> Board Checkers
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Checkers] -> Array (Int, Int) Checkers
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((1,1),(8,8)) [Checkers]
inicio
where
inicio :: [Checkers]
inicio = [[Checkers]] -> [Checkers]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Checkers]
vb, [Checkers]
bv, [Checkers]
vb, [Checkers]
v, [Checkers]
v, [Checkers]
pv, [Checkers]
vp, [Checkers]
pv]
padrão :: [a] -> [a]
padrão = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate 4
vb :: [Checkers]
vb = [Checkers] -> [Checkers]
forall a. [a] -> [a]
padrão [Checkers
V,Checkers
B]
bv :: [Checkers]
bv = [Checkers] -> [Checkers]
forall a. [a] -> [a]
padrão [Checkers
B,Checkers
V]
pv :: [Checkers]
pv = [Checkers] -> [Checkers]
forall a. [a] -> [a]
padrão [Checkers
P,Checkers
V]
vp :: [Checkers]
vp = [Checkers] -> [Checkers]
forall a. [a] -> [a]
padrão [Checkers
V,Checkers
P]
v :: [Checkers]
v = [Checkers] -> [Checkers]
forall a. [a] -> [a]
padrão [Checkers
V,Checkers
V]
within :: Ord a => (a,a) -> ((a, a), (a,a)) -> Bool
within :: (a, a) -> ((a, a), (a, a)) -> Bool
within (x :: a
x,y :: a
y) ((a :: a
a,b :: a
b), (c :: a
c,d :: a
d)) = Bool
inf Bool -> Bool -> Bool
&& Bool
sup
where
inf :: Bool
inf = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
a Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b
sup :: Bool
sup = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
c Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
d
valor :: Board a -> a
valor :: Board a -> a
valor (Board ix :: (Int, Int)
ix b :: Array (Int, Int) a
b) = Array (Int, Int) a
b Array (Int, Int) a -> (Int, Int) -> a
forall i e. Ix i => Array i e -> i -> e
! (Int, Int)
ix
para :: CoordFun -> Board a -> Maybe (Board a)
para :: CoordFun -> Board a -> Maybe (Board a)
para f :: CoordFun
f (Board c :: (Int, Int)
c b :: Array (Int, Int) a
b)
| CoordFun
f (Int, Int)
c (Int, Int) -> ((Int, Int), (Int, Int)) -> Bool
forall a. Ord a => (a, a) -> ((a, a), (a, a)) -> Bool
`within` Array (Int, Int) a -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Array (Int, Int) a
b = Board a -> Maybe (Board a)
forall a. a -> Maybe a
Just (Board a -> Maybe (Board a)) -> Board a -> Maybe (Board a)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Array (Int, Int) a -> Board a
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (CoordFun
f (Int, Int)
c) Array (Int, Int) a
b
| Bool
otherwise = Maybe (Board a)
forall a. Maybe a
Nothing
paraDireita, paraEsquerda, paraCima, paraBaixo :: Board a -> Maybe (Board a)
paraDireita :: Board a -> Maybe (Board a)
paraDireita = CoordFun -> Board a -> Maybe (Board a)
forall a. CoordFun -> Board a -> Maybe (Board a)
para (\(x :: Int
x,y :: Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, Int
y))
paraEsquerda :: Board a -> Maybe (Board a)
paraEsquerda = CoordFun -> Board a -> Maybe (Board a)
forall a. CoordFun -> Board a -> Maybe (Board a)
para (\(x :: Int
x,y :: Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-1, Int
y))
paraCima :: Board a -> Maybe (Board a)
paraCima = CoordFun -> Board a -> Maybe (Board a)
forall a. CoordFun -> Board a -> Maybe (Board a)
para (\(x :: Int
x,y :: Int
y) -> (Int
x, Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))
paraBaixo :: Board a -> Maybe (Board a)
paraBaixo = CoordFun -> Board a -> Maybe (Board a)
forall a. CoordFun -> Board a -> Maybe (Board a)
para (\(x :: Int
x,y :: Int
y) -> (Int
x, Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
rebobina :: Board a -> Board a
rebobina :: Board a -> Board a
rebobina (Board (x :: Int
x,_) b :: Array (Int, Int) a
b) = (Int, Int) -> Array (Int, Int) a -> Board a
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (Int
x,1) Array (Int, Int) a
b
proximo :: Board a -> Maybe (Board a)
proximo :: Board a -> Maybe (Board a)
proximo b :: Board a
b =
case Board a -> Maybe (Board a)
forall a. Board a -> Maybe (Board a)
paraDireita Board a
b of
Nothing -> case Board a -> Maybe (Board a)
forall a. Board a -> Maybe (Board a)
paraBaixo Board a
b of
Nothing -> Maybe (Board a)
forall a. Maybe a
Nothing
Just b' :: Board a
b' -> Board a -> Maybe (Board a)
forall a. a -> Maybe a
Just (Board a -> Maybe (Board a)) -> Board a -> Maybe (Board a)
forall a b. (a -> b) -> a -> b
$ Board a -> Board a
forall a. Board a -> Board a
rebobina Board a
b'
mb :: Maybe (Board a)
mb -> Maybe (Board a)
mb
vizinhanca :: Board Checkers -> [[Checkers]]
vizinhanca :: Board Checkers -> [[Checkers]]
vizinhanca (Board (x :: Int
x,y :: Int
y) b :: Array (Int, Int) Checkers
b) = [[Array (Int, Int) Checkers
b Array (Int, Int) Checkers -> (Int, Int) -> Checkers
forall a. Ix a => Array (a, a) Checkers -> (a, a) -> Checkers
!? (Int
i,Int
j) | Int
j <- [Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-1..Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+1]] | Int
i <- [Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-1..Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+1]]
where
b' :: Array (a, a) Checkers
b' !? :: Array (a, a) Checkers -> (a, a) -> Checkers
!? c :: (a, a)
c
| (a, a)
c (a, a) -> ((a, a), (a, a)) -> Bool
forall a. Ord a => (a, a) -> ((a, a), (a, a)) -> Bool
`within` Array (a, a) Checkers -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) Checkers
b' = Array (a, a) Checkers
b' Array (a, a) Checkers -> (a, a) -> Checkers
forall i e. Ix i => Array i e -> i -> e
! (a, a)
c
| Bool
otherwise = Checkers
F
possivelMover :: Checkers -> [[Checkers]] -> Movimento
possivelMover :: Checkers -> [[Checkers]] -> Movimento
possivelMover B
[[B, _, _]
,[_, V, _]
,[_, _, _]]
= [((-1,-1),Checkers
V), ((0,0), Checkers
B)]
possivelMover B
[[_, _, B]
,[_, V, _]
,[_, _, _]]
= [((-1,1),Checkers
V), ((0,0),Checkers
B)]
possivelMover P
[[_, _, _]
,[_, V, _]
,[_, _, P]]
= [((1,1),Checkers
V), ((0,0),Checkers
P)]
possivelMover P
[[_, _, _]
,[_, V, _]
,[P, _, _]]
= [((1,-1),Checkers
V), ((0,0),Checkers
P)]
possivelMover _ _ = []
possivelAtacar :: Checkers -> [[Checkers]] -> Movimento
possivelAtacar :: Checkers -> [[Checkers]] -> Movimento
possivelAtacar B
[[B, _, _]
,[_, P, _]
,[_, _, V]]
= [((-1,-1),Checkers
V),((0,0),Checkers
V),((1,1),Checkers
B)]
possivelAtacar B
[[_, _, B]
,[_, P, _]
,[V, _, _]]
= [((-1,1),Checkers
V),((0,0),Checkers
V),((1,-1),Checkers
B)]
possivelAtacar P
[[V, _, _]
,[_, B, _]
,[_, _, P]]
= [((-1,-1),Checkers
P),((0,0),Checkers
V),((1,1),Checkers
V)]
possivelAtacar P
[[_, _, V]
,[_, B, _]
,[P, _, _]]
= [((-1,1),Checkers
P),((0,0),Checkers
V),((1,-1),Checkers
V)]
possivelAtacar _ _ = []
paraComeco :: Board a -> Board a
paraComeco :: Board a -> Board a
paraComeco (Board _ b :: Array (Int, Int) a
b) = (Int, Int) -> Array (Int, Int) a -> Board a
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (1,1) Array (Int, Int) a
b
ataques, movimentos :: Checkers -> Board Checkers -> Board Movimento
ataques :: Checkers -> Board Checkers -> Board Movimento
ataques peça :: Checkers
peça = (Board Checkers -> Movimento) -> Board Checkers -> Board Movimento
forall a b. (Board a -> b) -> Board a -> Board b
aplica (Checkers -> [[Checkers]] -> Movimento
possivelAtacar Checkers
peça ([[Checkers]] -> Movimento)
-> (Board Checkers -> [[Checkers]]) -> Board Checkers -> Movimento
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board Checkers -> [[Checkers]]
vizinhanca)
movimentos :: Checkers -> Board Checkers -> Board Movimento
movimentos peça :: Checkers
peça = (Board Checkers -> Movimento) -> Board Checkers -> Board Movimento
forall a b. (Board a -> b) -> Board a -> Board b
aplica (Checkers -> [[Checkers]] -> Movimento
possivelMover Checkers
peça ([[Checkers]] -> Movimento)
-> (Board Checkers -> [[Checkers]]) -> Board Checkers -> Movimento
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board Checkers -> [[Checkers]]
vizinhanca)
aplica :: (Board a -> b) -> Board a -> Board b
aplica :: (Board a -> b) -> Board a -> Board b
aplica f :: Board a -> b
f (Board ix :: (Int, Int)
ix b :: Array (Int, Int) a
b) =
let
limites :: ((Int, Int), (Int, Int))
limites = Array (Int, Int) a -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Array (Int, Int) a
b
ixs :: [(Int, Int)]
ixs = Array (Int, Int) a -> [(Int, Int)]
forall i e. Ix i => Array i e -> [i]
indices Array (Int, Int) a
b
g :: (Int, Int) -> ((Int, Int), b)
g i :: (Int, Int)
i = ((Int, Int)
i, Board a -> b
f ((Int, Int) -> Array (Int, Int) a -> Board a
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (Int, Int)
i Array (Int, Int) a
b))
b' :: Array (Int, Int) b
b' = ((Int, Int), (Int, Int)) -> [((Int, Int), b)] -> Array (Int, Int) b
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int), (Int, Int))
limites ([((Int, Int), b)] -> Array (Int, Int) b)
-> [((Int, Int), b)] -> Array (Int, Int) b
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> ((Int, Int), b))
-> [(Int, Int)] -> [((Int, Int), b)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> ((Int, Int), b)
g [(Int, Int)]
ixs
in (Int, Int) -> Array (Int, Int) b -> Board b
forall a. (Int, Int) -> Array (Int, Int) a -> Board a
Board (Int, Int)
ix Array (Int, Int) b
b'
escolha :: Board Movimento -> Movimento
escolha :: Board Movimento -> Movimento
escolha b :: Board Movimento
b
| (Bool -> Bool
not (Bool -> Bool) -> (Movimento -> Bool) -> Movimento -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Movimento -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Movimento
movimento = (((Int, Int), Checkers) -> ((Int, Int), Checkers))
-> Movimento -> Movimento
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> ((Int, Int), Checkers) -> ((Int, Int), Checkers)
forall a b b.
(Num a, Num b) =>
(a, b) -> ((a, b), b) -> ((a, b), b)
adiciona (Board Movimento -> (Int, Int)
forall a. Board a -> (Int, Int)
foco Board Movimento
b)) Movimento
movimento
| Bool
otherwise = case Board Movimento -> Maybe (Board Movimento)
forall a. Board a -> Maybe (Board a)
proximo Board Movimento
b of
Nothing -> []
Just b' :: Board Movimento
b' -> Board Movimento -> Movimento
escolha Board Movimento
b'
where
movimento :: Movimento
movimento = Board Movimento -> Movimento
forall a. Board a -> a
valor Board Movimento
b
adiciona :: (a, b) -> ((a, b), b) -> ((a, b), b)
adiciona xy :: (a, b)
xy (ij :: (a, b)
ij,p :: b
p) = ((a, b)
xy (a, b) -> (a, b) -> (a, b)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
.+. (a, b)
ij,b
p)
(x :: a
x,y :: b
y) .+. :: (a, b) -> (a, b) -> (a, b)
.+. (i :: a
i,j :: b
j) = (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
i, b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
j)
move :: Checkers -> Board Checkers -> Board Checkers
move :: Checkers -> Board Checkers -> Board Checkers
move p :: Checkers
p b :: Board Checkers
b
| Movimento -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Movimento
atks = Board Checkers
b { board :: Array (Int, Int) Checkers
board = Board Checkers -> Array (Int, Int) Checkers
forall a. Board a -> Array (Int, Int) a
board Board Checkers
b Array (Int, Int) Checkers -> Movimento -> Array (Int, Int) Checkers
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// Movimento
movs }
| Bool
otherwise = Board Checkers
b { board :: Array (Int, Int) Checkers
board = Board Checkers -> Array (Int, Int) Checkers
forall a. Board a -> Array (Int, Int) a
board Board Checkers
b Array (Int, Int) Checkers -> Movimento -> Array (Int, Int) Checkers
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// Movimento
atks }
where
atks :: Movimento
atks = Board Movimento -> Movimento
escolha (Board Movimento -> Movimento) -> Board Movimento -> Movimento
forall a b. (a -> b) -> a -> b
$ Checkers -> Board Checkers -> Board Movimento
ataques Checkers
p Board Checkers
b
movs :: Movimento
movs = Board Movimento -> Movimento
escolha (Board Movimento -> Movimento) -> Board Movimento -> Movimento
forall a b. (a -> b) -> a -> b
$ Checkers -> Board Checkers -> Board Movimento
movimentos Checkers
p Board Checkers
b
alternaVez :: Checkers -> Board Checkers -> [Board Checkers]
alternaVez :: Checkers -> Board Checkers -> [Board Checkers]
alternaVez p :: Checkers
p b :: Board Checkers
b = Board Checkers
b' Board Checkers -> [Board Checkers] -> [Board Checkers]
forall a. a -> [a] -> [a]
: Checkers -> Board Checkers -> [Board Checkers]
alternaVez Checkers
p' Board Checkers
b'
where
b' :: Board Checkers
b' = Checkers -> Board Checkers -> Board Checkers
move Checkers
p Board Checkers
b
p' :: Checkers
p' = if Checkers
pCheckers -> Checkers -> Bool
forall a. Eq a => a -> a -> Bool
==Checkers
B then Checkers
P else Checkers
B
main :: IO ()
main :: IO ()
main = do
Board Checkers -> IO ()
forall a. Show a => a -> IO ()
print Board Checkers
initialBoard
(Board Checkers -> IO ()) -> [Board Checkers] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Board Checkers -> IO ()
forall a. Show a => a -> IO ()
print ([Board Checkers] -> IO ()) -> [Board Checkers] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Board Checkers] -> [Board Checkers]
forall a. Int -> [a] -> [a]
take 10 ([Board Checkers] -> [Board Checkers])
-> [Board Checkers] -> [Board Checkers]
forall a b. (a -> b) -> a -> b
$ Checkers -> Board Checkers -> [Board Checkers]
alternaVez Checkers
B Board Checkers
initialBoard