{-# 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