module Rendering (drawBoard) where import Graphics.Gloss import GameModel import Types rowHeight :: Float rowHeight = 100 tilePrecision :: Int tilePrecision = 10 tileS :: Float tileS = 90 tileRoundness :: Float tileRoundness = 4 textScale :: Float textScale = 0.2 tileBackColor :: Color tileBackColor = makeColorI 205 192 180 255 roundedRect :: Int -> Float -> Float -> Float -> Picture roundedRect n w h r = pictures [ drawQuarterRoundedRect n w h r , rotate 90 $ drawQuarterRoundedRect n w h r , rotate 180 $ drawQuarterRoundedRect n w h r , rotate 270 $ drawQuarterRoundedRect n w h r ] getPoint :: Float -> Float -> Float -> Float -> (Float,Float) getPoint x y r th = (x+r*cos th, y+r*sin th) arcPath :: Int -> (Float,Float) -> Float -> Path arcPath n (x,y) r = map (getPoint x y r) $ 0.0 : map (\v -> pi / 2 / fromIntegral v) (reverse [1..n+1]) quarterRoundedRect :: Int -> Float -> Float -> Float -> Path quarterRoundedRect n w h r = [(0,0), (0,h/2)] ++ reverse (arcPath n (w / 2 - r, h / 2 - r) r) ++ [(w/2,0)] drawQuarterRoundedRect :: Int -> Float -> Float -> Float -> Picture drawQuarterRoundedRect n w h r = polygon $ quarterRoundedRect n w h r drawTileBack :: Float -> Picture drawTileBack x = color tileBackColor (translate x 0 (roundedRect tilePrecision tileS tileS tileRoundness)) -- Takes x-offset and tile and draws the tile itself drawTile :: Float -> Tile -> Picture drawTile x tile = let background = [color (tileColor tile) $ roundedRect tilePrecision tileS tileS tileRoundness] number = if tileToInt tile > 0 then [translate (-20) (-10) $ scale textScale textScale $ text $ show $ tileToInt tile] else [] curScale = 1 in pictures [ drawTileBack x , translate x 0 $ scale curScale curScale $ pictures $ background ++ number ] drawRow :: [Tile] -> Picture drawRow tile = let [i, j, k, l] = tile in translate (-300) 0 (pictures [ drawTile 0 i , drawTile rowHeight j , drawTile (rowHeight * 2) k , drawTile (rowHeight * 3) l ]) gameOverMessage :: Picture gameOverMessage = pictures [ translate (-500) (-500) $ color translucentWhite $ rectangleSolid 2000 2000 , translate (-335) (-150) $ scale 0.5 0.5 $ color black $ text "Game Over" ] where translucentWhite = makeColorI 255 255 255 150 -- | Draw current board representation depending on the status of the game. -- All tiles will be drawn at all tiles and game over message is drawn onto -- the game board when game status is GameOver drawBoard :: GameState -> Picture drawBoard gameState = let (Board b) = board gameState [r1, r2, r3, r4] = b in translate 150 150 $ pictures $ [ drawRow r1 , translate 0 (-rowHeight) (drawRow r2) , translate 0 (-rowHeight * 2) (drawRow r3) , translate 0 (-rowHeight * 3) (drawRow r4) , translate (-300) 60 $ scale 0.2 0.2 $ color white $ text $ "Score: " ++ show (score gameState) ] ++ gameOverPicture where gameOverPicture = [gameOverMessage | status gameState == GameOver] -- | Tile colors up to tile with value 2048 taken directly from the -- original game. The rest of the numbers should be assigned some good -- values (well we can easily reach tile 4096 and some AI reach 32768) tileColor :: Tile -> Color tileColor tile = case tile of Number 2 -> makeColorI 238 228 218 255 Number 4 -> makeColorI 237 224 200 255 Number 8 -> makeColorI 242 177 121 255 Number 16 -> makeColorI 245 149 99 255 Number 32 -> makeColorI 246 124 95 255 Number 64 -> makeColorI 246 94 59 255 Number 128 -> makeColorI 237 207 114 255 Number 256 -> makeColorI 237 204 97 255 Number 512 -> makeColorI 237 200 80 255 Number 1024 -> makeColorI 237 197 63 255 Number 2048 -> makeColorI 237 194 46 255 Number 4096 -> makeColorI 237 194 46 255 -- TODO: needs appropriate color Number 8192 -> makeColorI 237 194 46 255 -- TODO: needs appropriate color Number 16384 -> makeColorI 237 194 46 255 -- TODO: needs appropriate color Number 32768 -> makeColorI 237 194 46 255 -- TODO: needs appropriate color Number 65536 -> makeColorI 237 194 46 255 -- TODO: needs appropriate color _ -> makeColorI 238 228 218 90