Implmement display system
This commit is contained in:
parent
3780e967cd
commit
ebb27755d2
24
src/Game/Display.hs
Normal file
24
src/Game/Display.hs
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
{-# LANGUAGE Arrows #-}
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
|
module Game.Display where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.Trans.MSF.Reader
|
||||||
|
import Control.Monad.Trans.MSF.Writer
|
||||||
|
import Data.Maybe
|
||||||
|
import Data.MonadicStreamFunction
|
||||||
|
import Game.State
|
||||||
|
import Game.Utils
|
||||||
|
import Graphics.Gloss
|
||||||
|
import Graphics.Gloss.Interface.IO.Game
|
||||||
|
|
||||||
|
getSquare :: (Int, Int) -> Picture
|
||||||
|
getSquare (toEnum -> x, toEnum -> y) =
|
||||||
|
translate (x * 25) (y * 25) $ rectangleSolid 25 25
|
||||||
|
|
||||||
|
displayState :: Monad m => MSF (DrawerT m) GameState ()
|
||||||
|
displayState = proc state -> do
|
||||||
|
draw -< mconcat $ color green . getSquare <$> state.snakePos
|
||||||
|
draw -< color red $ getSquare state.berryPos
|
|
@ -59,4 +59,5 @@ mainSF = proc () -> do
|
||||||
-- undefined is safe here because the first frame is guaranteed to be a tick
|
-- undefined is safe here because the first frame is guaranteed to be a tick
|
||||||
state <- hold undefined -< state'
|
state <- hold undefined -< state'
|
||||||
|
|
||||||
returnA -< ()
|
-- Display the current state
|
||||||
|
displayState -< state
|
||||||
|
|
Loading…
Reference in a new issue