pituicat/src/Affection/Render.hs

36 lines
830 B
Haskell
Raw Normal View History

2016-03-25 15:58:46 +00:00
{-# LANGUAGE GADTs #-}
module Affection.Render
( RenderM
, inRender
) where
import Affection.Types (RGBA)
import SDL
import Linear (V4(..))
data RenderM :: * -> * where
Pure :: a -> RenderM a
Bind :: RenderM a -> (a -> RenderM b) -> RenderM b
Render :: (Renderer -> IO a) -> RenderM a
instance Functor RenderM where
fmap f m = Bind m (Pure . f)
instance Applicative RenderM where
pure x = Pure x
mf <*> mx = Bind mf (\f -> Bind mx (\x -> Pure (f x)))
instance Monad RenderM where
m >>= f = Bind m f
inRender :: Renderer -> RenderM a -> IO a
inRender _ (Pure a) = return a
inRender r (Bind m f) = do
result <- inRender m r
inRender (f result) r
inRender r (Render f) = f r
changeColor :: RGBA -> RenderM ()
changeColor (RGBA r g b a) = Render $ \renderer -> rendererDrawColor renderer $= V4 r g b a