36 lines
830 B
Haskell
36 lines
830 B
Haskell
|
{-# 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
|