Tetris mit Gloss
.Studieren Sie denLehrbrief zur Aufgabe und lösen Sie die Aufgaben.
Es gibt keine hinterlegten Unit-Tests, da man visuell genügend Feedback bekommt, ob die Lösung funktioniert.
> module GlossTetris where
> import Graphics.Gloss
> import Graphics.Gloss.Data.ViewPort
> import Graphics.Gloss.Interface.Pure.Game
> import System.Random
> import Control.Lens
> import Data.List
> ball
> = play
> (InWindow "Ball" (200, 500) (0, 0))
> black
> 60
> (480.0,0.4,0)
> (\(h,v0,t)->translate 0 (h-250)$color red$circleSolid 10)
> (\inp x-> (480.0,0.4,0) )
> (\_ (h,v0,t) -> let v = v0 + 0.981 * t
> in if h<10 then (10,-v*0.8,0) else (h-v,v0,t+1))
> class Tetris a where
> newTetris :: IO a
> rows :: a -> Int
> columns :: a -> Int
> get :: a -> Int -> Int -> Color
> current :: a -> [(Int,Int)]
> ended :: a -> Bool
> move :: a -> a
> prInput :: Input -> a -> a
> data Input = Left|Right|RotateLeft|RotateRight|Fall deriving Eq
> background :: Color
> background = black
> inputHandler (EventKey (SpecialKey KeyLeft) Down _ _) game
> = prInput GlossTetris.Left game
> inputHandler (EventKey (SpecialKey KeyRight) Down _ _) game
> = prInput GlossTetris.Right game
> inputHandler (EventKey (SpecialKey KeyUp) Down _ _) game
> = prInput RotateRight game
> inputHandler (EventKey (SpecialKey KeyDown) Down _ _) game
> = prInput RotateLeft game
> inputHandler (EventKey (SpecialKey KeySpace) Down _ _) game
> = prInput Fall game
> inputHandler _ game = game
> update seconds game = move game
> render w (t,game) =
> pictures
> ([ square (x * w - width `div` 2 + w `div` 2)
> (-y * w + height `div` 2 + w `div` 2) c
> | x <- [0 .. columns game-1],y <- [0 .. rows game-1]
> , let c = get game x y
> ]++
> [ square (x * w -width `div` 2+w `div` 2)
> (-y * w +height`div` 2+w `div` 2+t) red
> | (x,y)<-current game])
> where
> dXYf = fromIntegral w
> width = w*columns game
> height = w*rows game
> square x y c
> = translate (fromIntegral x) (fromIntegral y)
> (color c (rectangleSolid dXYf dXYf))
> moin :: Tetris a => Int -> a -> IO ()
> moin w game = play
> (InWindow "Tetris" (w*columns game,w*rows game) (20,20))
> background
> 60
> (w,game)
> (\g->render w g)
> (\inp (t,g)->(t,inputHandler inp g))
> (\f (t,g)->if t<=0 then (w,update f g) else (t-3,g))
> data OneTetris
> = OneTetris
> { mcurrent::(Int,Int)
> , randomGen1::StdGen
> , grid1:: [[Color]]
> , mcolumns1::Int
> , mrows1::Int
> }
> a = [12,3,4,5,5,6,7]
>
> updateAt i e [] = []
> updateAt 0 e (x:xs) = (e:xs)
> updateAt n e (x:xs) = (x:updateAt (n-1) e xs)
>
> a' = updateAt 3 42 a
> b = a & (ix 3) .~ 42
> setColor x y c grd = grd& (ix y) .~ ((grd!!y) & (ix x) .~ c)
> nof n = take n.repeat
> instance Tetris OneTetris where
> newTetris = do
> gen <- getStdGen
> let (c,gen') = uniformR (0, 19) gen
> return$OneTetris (c,0) gen' (nof 30$nof 20 background) 20 30
> rows = mrows1
> columns = mcolumns1
> get g c r= grid1 g!!r!!c
> current g = [mcurrent g]
> ended g = False
> move g
> |y+1 >= rows g || get g x (y+1) /= background = g'
> |otherwise = g{mcurrent=(x,y+1)}
> where
> (x, y) = mcurrent g
> (c,gen') = uniformR (0, columns g -1) (randomGen1 g)
> g' = g{ mcurrent=(c, 0)
> , randomGen1=gen'
> , grid1 = removeFull$setColor x y red (grid1 g)
> }
> removeFull grd = (nof (length full)(nof 20 background))++notfull
> where
> (full, notfull) = partition (all (\c->c/=background)) grd
> prInput key g
> |x'<0 || x'>=columns g || get g x' y /= background = g
> |otherwise = g{mcurrent=(x',y)}
> where
> (x,y) = mcurrent g
> x'
> |key==GlossTetris.Left = x-1
> |key==GlossTetris.Right = x+1
> |otherwise = x
> play1 = do
> tetris <- newTetris::IO OneTetris
> moin 25 tetris
> play2 = do
> tetris <- newTetris::IO MoreTetris
> moin 25 tetris
> data MoreTetris
> = MoreTetris
> { mcurrent2::[(Int,Int)]
> , randomGen2::StdGen
> , grid2:: [[Color]]
> , mcolumns2::Int
> , mrows2::Int
> }
> instance Tetris MoreTetris where
> newTetris = do
> gen <- getStdGen
> let (c,gen') = uniformR (1, 17) gen
> return$MoreTetris
> [(c-1,0),(c,0),(c+1,0),(c+2,0)]
> gen'
> (nof 30$nof 20 background) 20 30
> rows = mrows2
> columns = mcolumns2
> get g c r= grid2 g!!r!!c
> current = mcurrent2
> ended g = False
> move g = g
> prInput key g = g
lhs
You are not logged in and therefore you cannot submit a solution.
Subato
