Commit 1dc98095 authored by trehm001's avatar trehm001
Browse files

cleanup

parent 647853fd
......@@ -10,8 +10,8 @@ import Piece
import System.Random (getStdGen, randomRs)
width, height :: Int
width = 400
height = 800
width = 440
height = 840
window :: Display
window = InWindow "Tetris" (width, height) (0, 0)
......@@ -67,36 +67,12 @@ nextPiece game = insertActivePiece (Piece nextTetroShape (4, 21) (getTetroColor
where
nextTetroShape = head (upcomingTetros game)
getTetroColor :: Shape -> Color
getTetroColor TetrominoI = aquamarine
getTetroColor TetrominoJ = blue
getTetroColor TetrominoL = orange
getTetroColor TetrominoO = yellow
getTetroColor TetrominoS = green
getTetroColor TetrominoT = violet
getTetroColor TetrominoZ = red
insertActivePiece :: Piece -> TetrisGame -> TetrisGame
insertActivePiece p@(Piece shape (x, y) col) game = foldl (\g (x', y') -> g {activePiece = p, grid = insert (toInteger (x + x'), toInteger (y + y')) col (grid g)}) game (getCoords shape)
randomPiece :: Piece
randomPiece = undefined
render :: TetrisGame -> Picture
render game =
pictures $
[ translate
(fromInteger x * dimension - 200)
(fromInteger y * dimension - 400)
(color (c x y) (rectangleSolid dimension dimension))
| let c = chooseColor (grid game),
x <- [0 .. 10],
y <- [0 .. 21]
]
where
chooseColor :: Map (Integer, Integer) Color -> Integer -> Integer -> Color
chooseColor m x y = m ! (x, y)
gravitateActivePiece :: TetrisGame -> Piece -> TetrisGame
gravitateActivePiece game p@(Piece shape (x, y) col)
| freeSpot game = insertActivePiece (Piece shape (x, y -1) col) (removePiece p game)
......@@ -130,10 +106,6 @@ freeSpot g@(Game p@(Piece TetrominoZ (x, y) col) grid _) =
&& testField (Map.lookup (toInteger x, toInteger y -1) grid)
&& testField (Map.lookup (toInteger x + 1, toInteger y -1) grid)
-- Test if Color Matches free Field
testField :: Maybe Color -> Bool
testField col = Data.Maybe.fromMaybe black col == background
canMove :: Direction -> TetrisGame -> Bool
--TetrominoI
canMove Main.Left g@(Game p@(Piece TetrominoI (x, y) col) grid _) =
......@@ -189,10 +161,9 @@ canMove Main.Right g@(Game p@(Piece TetrominoZ (x, y) col) grid _) =
testField (Map.lookup (toInteger x + 2, toInteger y) grid)
&& testField (Map.lookup (toInteger x + 1, toInteger y + 1) grid)
movePiece :: SpecialKey -> TetrisGame -> TetrisGame
movePiece KeyLeft g@(Game p@(Piece shape (x, y) col) grid _) = if canMove Main.Left g then insertActivePiece (Piece shape (x -1, y) col) (removePiece p g) else g
movePiece KeyRight g@(Game p@(Piece shape (x, y) col) grid _) = if canMove Main.Right g then insertActivePiece (Piece shape (x + 1, y) col) (removePiece p g) else g
movePiece _ game = game
-- Test if Color Matches free Field
testField :: Maybe Color -> Bool
testField col = Data.Maybe.fromMaybe black col == background
removePiece :: Piece -> TetrisGame -> TetrisGame
removePiece p@(Piece shape (x, y) col) game = foldl (\g (x', y') -> g {activePiece = p, grid = insert (toInteger (x + x'), toInteger (y + y')) background (grid g)}) game (getCoords shape)
......@@ -200,21 +171,16 @@ removePiece p@(Piece shape (x, y) col) game = foldl (\g (x', y') -> g {activePie
removeRow :: Int -> TetrisGame -> TetrisGame
removeRow y game = foldl (\g x -> g {grid = insert (toInteger x, toInteger y) background (grid g)}) game [0 .. 10]
shiftDownFields :: TetrisGame -> TetrisGame
shiftDownFields game = foldl (\g (y, x) -> g {grid = insert (toInteger x, toInteger y) black (grid g)}) game [(x, y) | x <- [0 .. 21], y <- [0 .. 10]]
where
color g x y = Data.Maybe.fromMaybe black (Map.lookup (toInteger x, toInteger (y + 1)) (grid g))
testDownFields :: Int -> Int -> TetrisGame -> TetrisGame
testDownFields _ 22 game = game
testDownFields 11 y game = testDownFields 0 (y + 1) game
testDownFields x y game = game {grid = insert (toInteger x, toInteger y) (color game x y) (grid (testDownFields (x + 1) y game))}
shiftDownFields :: Int -> Int -> TetrisGame -> TetrisGame
shiftDownFields _ 22 game = game
shiftDownFields 11 y game = shiftDownFields 0 (y + 1) game
shiftDownFields x y game = game {grid = insert (toInteger x, toInteger y) (color game x y) (grid (shiftDownFields (x + 1) y game))}
where
color g x y = Data.Maybe.fromMaybe background (Map.lookup (toInteger x, toInteger (y + 1)) (grid g))
tryClearRows :: TetrisGame -> TetrisGame
tryClearRows game
| b = nextPiece $ testDownFields 0 y $ removeRow y game
| b = nextPiece $ shiftDownFields 0 y $ removeRow y game
| otherwise = game
where
(b, y) = rowClearable game 0 0
......@@ -227,6 +193,11 @@ rowClearable g@(Game p grid _) x y =
then rowClearable g (x + 1) y
else rowClearable g 0 (y + 1)
movePiece :: SpecialKey -> TetrisGame -> TetrisGame
movePiece KeyLeft g@(Game p@(Piece shape (x, y) col) grid _) = if canMove Main.Left g then insertActivePiece (Piece shape (x -1, y) col) (removePiece p g) else g
movePiece KeyRight g@(Game p@(Piece shape (x, y) col) grid _) = if canMove Main.Right g then insertActivePiece (Piece shape (x + 1, y) col) (removePiece p g) else g
movePiece _ game = game
inputHandler :: Event -> TetrisGame -> TetrisGame
inputHandler (EventKey (SpecialKey KeyLeft) Down _ _) game = movePiece KeyLeft game
inputHandler (EventKey (SpecialKey KeyRight) Down _ _) game = movePiece KeyRight game
......@@ -237,6 +208,21 @@ update seconds game = tryClearRows $ gravitateActivePiece game piece
where
piece = activePiece game
render :: TetrisGame -> Picture
render game =
pictures $
[ translate
(fromInteger x * dimension - 200)
(fromInteger y * dimension - 400)
(color (c x y) (rectangleSolid dimension dimension))
| let c = chooseColor (grid game),
x <- [0 .. 10],
y <- [0 .. 21]
]
where
chooseColor :: Map (Integer, Integer) Color -> Integer -> Integer -> Color
chooseColor m x y = m ! (x, y)
main :: IO ()
main =
getRandomTypes >>= \ts -> play window background fps (initialState ts) render inputHandler update
\ No newline at end of file
......@@ -4,7 +4,6 @@ import Graphics.Gloss
data Shape = TetrominoI | TetrominoJ | TetrominoL | TetrominoO | TetrominoS | TetrominoT | TetrominoZ deriving (Show)
-- (0,0) Origin & rotaion point
data Piece = Piece Shape (Int, Int) Color deriving (Show)
getCoords :: Shape -> [(Int, Int)]
......@@ -14,4 +13,13 @@ getCoords TetrominoL = [(0, 0), (-1, 0), (1, 0), (1, 1)]
getCoords TetrominoO = [(0, 0), (-1, 0), (-1, 1), (0, 1)]
getCoords TetrominoS = [(0, 0), (-1, 0), (0, 1), (1, 1)]
getCoords TetrominoT = [(0, 0), (-1, 0), (0, 1), (1, 0)]
getCoords TetrominoZ = [(0, 0), (0, 1), (-1, 1), (1, 0)]
\ No newline at end of file
getCoords TetrominoZ = [(0, 0), (0, 1), (-1, 1), (1, 0)]
getTetroColor :: Shape -> Color
getTetroColor TetrominoI = aquamarine
getTetroColor TetrominoJ = blue
getTetroColor TetrominoL = orange
getTetroColor TetrominoO = yellow
getTetroColor TetrominoS = green
getTetroColor TetrominoT = violet
getTetroColor TetrominoZ = red
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment