{-# LANGUAGE TupleSections #-}
module Main where
import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Game
import System.Random
import Database
import Desenhos
listaPecas :: IO [Tetramino]
listaPecas :: IO [Tetramino]
listaPecas = (Int -> Tetramino) -> [Int] -> [Tetramino]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Int
x -> [Tetramino
I .. Tetramino
S] [Tetramino] -> Int -> Tetramino
forall a. [a] -> Int -> a
!! Int
x) ([Int] -> [Tetramino]) -> IO [Int] -> IO [Tetramino]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdGen -> [Int]) -> IO StdGen -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (0 :: Int, 6 :: Int)) IO StdGen
getStdGen
mundoInicial :: [Tetramino] -> Mundo
mundoInicial :: [Tetramino] -> Mundo
mundoInicial [] = Mundo
forall a. HasCallStack => a
undefined
mundoInicial (t :: Tetramino
t:ts :: [Tetramino]
ts) = [(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo ((Coord -> (Coord, Color)) -> [Coord] -> [(Coord, Color)]
forall a b. (a -> b) -> [a] -> [b]
map (, Peca -> Color
cor Peca
p) (Peca -> [Coord]
blocosPeca Peca
p)) Peca
p [Tetramino]
ts 0 3 0 Bool
False
where p :: Peca
p = Tetramino -> Peca
criaPeca Tetramino
t
joga :: Event -> Mundo -> Mundo
joga :: Event -> Mundo -> Mundo
joga (EventKey (SpecialKey k :: SpecialKey
k) Down _ _) m :: Mundo
m =
if Mundo -> Bool
gameOver Mundo
m
then Mundo
m
else Mundo
m {blocosPintados :: [(Coord, Color)]
blocosPintados = [(Coord, Color)]
blocos, pecaAtual :: Peca
pecaAtual = Peca
novaP}
where
novaP :: Peca
novaP = case SpecialKey
k of
KeyRight -> if Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Dir then Direcao -> Peca -> Peca
move Direcao
Dir (Peca -> Peca) -> Peca -> Peca
forall a b. (a -> b) -> a -> b
$ Mundo -> Peca
pecaAtual Mundo
m else Mundo -> Peca
pecaAtual Mundo
m
KeyLeft -> if Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Esq then Direcao -> Peca -> Peca
move Direcao
Esq (Peca -> Peca) -> Peca -> Peca
forall a b. (a -> b) -> a -> b
$ Mundo -> Peca
pecaAtual Mundo
m else Mundo -> Peca
pecaAtual Mundo
m
KeyDown -> if Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Baixo then Direcao -> Peca -> Peca
move Direcao
Baixo (Peca -> Peca) -> Peca -> Peca
forall a b. (a -> b) -> a -> b
$ Mundo -> Peca
pecaAtual Mundo
m else Mundo -> Peca
pecaAtual Mundo
m
KeyUp -> if Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Rotaciona then Direcao -> Peca -> Peca
move Direcao
Rotaciona (Peca -> Peca) -> Peca -> Peca
forall a b. (a -> b) -> a -> b
$ Mundo -> Peca
pecaAtual Mundo
m else Mundo -> Peca
pecaAtual Mundo
m
KeySpace -> Mundo -> Peca
moveFundo Mundo
m
_ -> Mundo -> Peca
pecaAtual Mundo
m
blocos :: [(Coord, Color)]
blocos = ((Coord, Color) -> Bool) -> [(Coord, Color)] -> [(Coord, Color)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(x :: Coord
x, _) -> Coord
x Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Peca -> [Coord]
blocosPeca (Mundo -> Peca
pecaAtual Mundo
m)) (Mundo -> [(Coord, Color)]
blocosPintados Mundo
m)
[(Coord, Color)] -> [(Coord, Color)] -> [(Coord, Color)]
forall a. [a] -> [a] -> [a]
++ (Coord -> (Coord, Color)) -> [Coord] -> [(Coord, Color)]
forall a b. (a -> b) -> [a] -> [b]
map (, Peca -> Color
cor Peca
novaP) (Peca -> [Coord]
blocosPeca Peca
novaP)
joga _ m :: Mundo
m = Mundo
m
podeMover :: Mundo -> Direcao -> Bool
podeMover :: Mundo -> Direcao -> Bool
podeMover m :: Mundo
m d :: Direcao
d = Bool -> Bool
not ((Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Coord]
bsM) [Coord]
bsP
Bool -> Bool -> Bool
|| (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== -280) (Float -> Bool) -> (Coord -> Float) -> Coord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> Float
forall a b. (a, b) -> b
snd) (Peca -> [Coord]
blocosPeca (Peca -> [Coord]) -> Peca -> [Coord]
forall a b. (a -> b) -> a -> b
$ Mundo -> Peca
pecaAtual Mundo
m))
where
bsP :: [Coord]
bsP = Peca -> [Coord]
blocosPeca (Direcao -> Peca -> Peca
move Direcao
d (Mundo -> Peca
pecaAtual Mundo
m))
bsM :: [Coord]
bsM = (Coord -> Bool) -> [Coord] -> [Coord]
forall a. (a -> Bool) -> [a] -> [a]
filter (Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Peca -> [Coord]
blocosPeca (Mundo -> Peca
pecaAtual Mundo
m)) (((Coord, Color) -> Coord) -> [(Coord, Color)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, Color) -> Coord
forall a b. (a, b) -> a
fst (Mundo -> [(Coord, Color)]
blocosPintados Mundo
m))
move :: Direcao -> Peca -> Peca
move :: Direcao -> Peca -> Peca
move d :: Direcao
d p :: Peca
p@(Peca t :: Tetramino
t c :: Color
c (x :: Float
x, y :: Float
y) bs :: [Coord]
bs) =
case Direcao
d of
Dir -> if (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
limiteX) (Float -> Bool) -> (Coord -> Float) -> Coord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> Float
forall a b. (a, b) -> a
fst) [Coord]
bs then Peca
p
else Tetramino -> Color -> Coord -> [Coord] -> Peca
Peca Tetramino
t Color
c (Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
tam, Float
y) ((Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Float
a, b :: Float
b) -> (Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
tam, Float
b)) [Coord]
bs)
Esq -> if (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== -Float
limiteX) (Float -> Bool) -> (Coord -> Float) -> Coord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> Float
forall a b. (a, b) -> a
fst) [Coord]
bs then Peca
p
else Tetramino -> Color -> Coord -> [Coord] -> Peca
Peca Tetramino
t Color
c (Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
tam, Float
y) ((Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Float
a, b :: Float
b) -> (Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
tam, Float
b)) [Coord]
bs)
Baixo -> if (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== -Float
limiteY) (Float -> Bool) -> (Coord -> Float) -> Coord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> Float
forall a b. (a, b) -> b
snd) [Coord]
bs then Peca
p
else Tetramino -> Color -> Coord -> [Coord] -> Peca
Peca Tetramino
t Color
c (Float
x, Float
yFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
tam) ((Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Float
a, b :: Float
b) -> (Float
a, Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
tam)) [Coord]
bs)
Rotaciona -> if Tetramino
t Tetramino -> Tetramino -> Bool
forall a. Eq a => a -> a -> Bool
== Tetramino
O
then Peca
p
else Tetramino -> Color -> Coord -> [Coord] -> Peca
Peca Tetramino
t Color
c ([Coord]
novaP [Coord] -> Int -> Coord
forall a. [a] -> Int -> a
!! 1) [Coord]
novaP
where
novaP :: [Coord]
novaP = (Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Float
a, b :: Float
b) -> (Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
sinal, Float
b)) [Coord]
pecaRot
sinal :: Float
sinal
| (Float -> Bool) -> [Float] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> 0) [Float]
volta = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
volta
| (Float -> Bool) -> [Float] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 0) [Float]
volta = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
volta
| Bool
otherwise = 0
volta :: [Float]
volta = (Coord -> Float) -> [Coord] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Float
voltaLimite [Coord]
pecaRot
pecaRot :: [Coord]
pecaRot = (Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Coord
rotaciona [Coord]
bs
rotaciona :: Coord -> Coord
rotaciona (a :: Float
a, b :: Float
b) = (Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
yFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
b, Float
yFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
a)
voltaLimite :: Coord -> Float
voltaLimite :: Coord -> Float
voltaLimite (a :: Float
a, _)
| Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
limiteX = Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
limiteX
| Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< -Float
limiteX = Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
limiteX
| Bool
otherwise = 0
moveFundo :: Mundo -> Peca
moveFundo :: Mundo -> Peca
moveFundo m :: Mundo
m = if Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Baixo
then Mundo -> Peca
moveFundo (Mundo -> Peca) -> Mundo -> Peca
forall a b. (a -> b) -> a -> b
$ Mundo
m {pecaAtual :: Peca
pecaAtual = Direcao -> Peca -> Peca
move Direcao
Baixo (Mundo -> Peca
pecaAtual Mundo
m)}
else Mundo -> Peca
pecaAtual Mundo
m
atualizaMundo :: Float -> Mundo -> Mundo
atualizaMundo :: Float -> Mundo -> Mundo
atualizaMundo _ m :: Mundo
m@(Mundo bs :: [(Coord, Color)]
bs p :: Peca
p ps :: [Tetramino]
ps pont :: Int
pont t :: Int
t f :: Int
f g :: Bool
g)
| Bool -> Bool
not (Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Baixo) Bool -> Bool -> Bool
&& (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, y :: Float
y) -> Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
limiteY) (Peca -> [Coord]
blocosPeca Peca
p) = Mundo
m {gameOver :: Bool
gameOver = Bool
True}
| Bool -> Bool
not (Mundo -> Direcao -> Bool
podeMover Mundo
m Direcao
Baixo) =
if [(Coord, Color)]
novoBs [(Coord, Color)] -> [(Coord, Color)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Coord, Color)]
bs
then [(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo [(Coord, Color)]
novoBs (Tetramino -> Peca
criaPeca (Tetramino -> Peca) -> Tetramino -> Peca
forall a b. (a -> b) -> a -> b
$ [Tetramino] -> Tetramino
forall a. [a] -> a
head [Tetramino]
ps) ([Tetramino] -> [Tetramino]
forall a. [a] -> [a]
tail [Tetramino]
ps) Int
novaPont Int
t 0 Bool
g
else [(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo [(Coord, Color)]
bs (Tetramino -> Peca
criaPeca (Tetramino -> Peca) -> Tetramino -> Peca
forall a b. (a -> b) -> a -> b
$ [Tetramino] -> Tetramino
forall a. [a] -> a
head [Tetramino]
ps) ([Tetramino] -> [Tetramino]
forall a. [a] -> [a]
tail [Tetramino]
ps) Int
pont Int
t Int
f Bool
g
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo [(Coord, Color)]
blocos (Direcao -> Peca -> Peca
move Direcao
Baixo Peca
p) [Tetramino]
ps Int
pont 3 Int
f Bool
g
| Bool
otherwise = [(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo [(Coord, Color)]
bs Peca
p [Tetramino]
ps Int
pont (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Int
f Bool
g
where novoM :: Mundo
novoM = Mundo -> Mundo
limpaFileira Mundo
m
novoBs :: [(Coord, Color)]
novoBs = Mundo -> [(Coord, Color)]
blocosPintados Mundo
novoM
novaPont :: Int
novaPont = Int
pont Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
atualizaPont (Mundo -> Int
fileirasCompletas Mundo
novoM)
blocos :: [(Coord, Color)]
blocos = ((Coord, Color) -> Bool) -> [(Coord, Color)] -> [(Coord, Color)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(x :: Coord
x, _) -> Coord
x Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Peca -> [Coord]
blocosPeca Peca
p) [(Coord, Color)]
bs
[(Coord, Color)] -> [(Coord, Color)] -> [(Coord, Color)]
forall a. [a] -> [a] -> [a]
++ (Coord -> (Coord, Color)) -> [Coord] -> [(Coord, Color)]
forall a b. (a -> b) -> [a] -> [b]
map (, Peca -> Color
cor (Direcao -> Peca -> Peca
move Direcao
Baixo Peca
p)) (Peca -> [Coord]
blocosPeca (Direcao -> Peca -> Peca
move Direcao
Baixo Peca
p))
limpaFileira :: Mundo -> Mundo
limpaFileira :: Mundo -> Mundo
limpaFileira m :: Mundo
m@(Mundo bs :: [(Coord, Color)]
bs p :: Peca
p ps :: [Tetramino]
ps pont :: Int
pont t :: Int
t f :: Int
f g :: Bool
g)
| [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Coord]
bsPeca = Mundo
m
| Bool
otherwise =
if (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Coord, Color) -> Coord) -> [(Coord, Color)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, Color) -> Coord
forall a b. (a, b) -> a
fst [(Coord, Color)]
bs) [Coord]
fileira
then Mundo -> Mundo
limpaFileira ([(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo (((Coord, Color) -> (Coord, Color))
-> [(Coord, Color)] -> [(Coord, Color)]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, Color) -> (Coord, Color)
forall a b. ((a, Float), b) -> ((a, Float), b)
desce (((Coord, Color) -> Bool) -> [(Coord, Color)] -> [(Coord, Color)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(x :: Coord
x, _) -> Coord
x Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Coord]
fileira) [(Coord, Color)]
bs)) Peca
p [Tetramino]
ps Int
pont Int
t (Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Bool
g)
else Mundo -> Mundo
limpaFileira ([(Coord, Color)]
-> Peca -> [Tetramino] -> Int -> Int -> Int -> Bool -> Mundo
Mundo [(Coord, Color)]
bs (Peca
p {blocosPeca :: [Coord]
blocosPeca = [Coord] -> [Coord]
forall a. [a] -> [a]
tail [Coord]
bsPeca}) [Tetramino]
ps Int
pont Int
t Int
f Bool
g)
where fileira :: [Coord]
fileira = [(Float
x, Coord -> Float
forall a b. (a, b) -> b
snd (Coord -> Float) -> Coord -> Float
forall a b. (a -> b) -> a -> b
$ [Coord] -> Coord
forall a. [a] -> a
head [Coord]
bsPeca) | Float
x <- [-Float
limiteX, -Float
limiteXFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
tam .. Float
limiteX]]
bsPeca :: [Coord]
bsPeca = Peca -> [Coord]
blocosPeca Peca
p
desce :: ((a, Float), b) -> ((a, Float), b)
desce = \((a :: a
a, b :: Float
b), c :: b
c) -> if Float
b Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Coord -> Float
forall a b. (a, b) -> b
snd ([Coord] -> Coord
forall a. [a] -> a
head [Coord]
bsPeca)
then ((a
a, Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
tam), b
c)
else ((a
a, Float
b), b
c)
atualizaPont :: Int -> Int
atualizaPont :: Int -> Int
atualizaPont 0 = 0
atualizaPont 1 = 100
atualizaPont 2 = 250
atualizaPont 3 = 500
atualizaPont 4 = 1000
atualizaPont _ = 0
main :: IO ()
main :: IO ()
main = do
[Tetramino]
ps <- IO [Tetramino]
listaPecas
Display
-> Color
-> Int
-> Mundo
-> (Mundo -> Picture)
-> (Event -> Mundo -> Mundo)
-> (Float -> Mundo -> Mundo)
-> IO ()
forall world.
Display
-> Color
-> Int
-> world
-> (world -> Picture)
-> (Event -> world -> world)
-> (Float -> world -> world)
-> IO ()
play
Display
janela
Color
black
10
([Tetramino] -> Mundo
mundoInicial [Tetramino]
ps)
Mundo -> Picture
desenhaMundo
Event -> Mundo -> Mundo
joga
Float -> Mundo -> Mundo
atualizaMundo
where
janela :: Display
janela = String -> (Int, Int) -> (Int, Int) -> Display
InWindow "Tetris" (820, 580) (50, 50)