module Graphics.UI.LUI.Draw
(Position,Size
,Draw
,Compute
,render
,computeResult
,textSize
,computeToDraw
,text
,rect
,move
) where
import qualified Graphics.UI.HaskGame as HaskGame
import qualified Graphics.UI.HaskGame.Font as Font
import qualified Graphics.UI.HaskGame.Rect as Rect
import Graphics.UI.HaskGame.Vector2(Vector2(..))
import Graphics.UI.HaskGame.Color(Color)
import Graphics.UI.HaskGame.Font(Font)
import Control.Monad.Trans(lift)
import Control.Monad.Reader(ReaderT, ask, local, runReaderT)
type Position = Vector2 Int
type Size = Vector2 Int
newtype Compute a = Compute { unCompute :: IO a }
deriving Monad
liftIO :: IO a -> Compute a
liftIO = Compute
newtype Draw a = Draw { unDraw :: ReaderT HaskGame.Surface (ReaderT Position Compute) a }
deriving Monad
liftPosition :: ReaderT Position Compute a -> Draw a
liftPosition = Draw . lift
liftSurface :: ReaderT HaskGame.Surface (ReaderT Position Compute) a -> Draw a
liftSurface = Draw
computeToDraw :: Compute a -> Draw a
computeToDraw = Draw . lift . lift
computeResult :: Compute a -> IO a
computeResult = unCompute
render :: HaskGame.Surface -> Position -> Draw a -> IO a
render surface pos = computeResult .
flip runReaderT pos .
flip runReaderT surface .
unDraw
textSize :: Font -> String -> Compute Size
textSize font str = do
liftIO $ Font.textSize font str
text :: Color -> Font -> String -> Draw Size
text color font str = do
surface <- liftSurface ask
position <- liftPosition ask
computeToDraw $ do
textSurface <- liftIO $ Font.renderText font str color
liftIO $ HaskGame.blit surface position textSurface
textSize font str
rect :: Color -> Size -> Draw Size
rect color size = do
surface <- liftSurface $ ask
position <- liftPosition ask
let r = Rect.makeRect position size
computeToDraw . liftIO $ HaskGame.fillRect surface r color
return size
move :: Position -> Draw a -> Draw a
move delta (Draw act) = do
surface <- liftSurface $ ask
let posReaderT = flip runReaderT surface act
liftPosition $ local (+delta) posReaderT