module Graphics.Rendering.OGL.GL.StateVar (
HasGetter(..),
GettableStateVar, makeGettableStateVar,
HasSetter(..), set,
SettableStateVar, makeSettableStateVar,
StateVar, makeStateVar,
($~), ($=!), ($~!), getIO, ($$=)
) where
import Data.IORef ( IORef, readIORef, writeIORef )
import Graphics.Rendering.OGL.Monad
($$=) :: HasSetter g => g a -> a -> IO ()
($$=) x y = runGL (x $= y)
getIO :: HasGetter g => g a -> IO a
getIO = runGL . get
infixr 2 $=
class HasGetter g where
get :: MonadGL m => g a -> m a
newtype GettableStateVar a = GettableStateVar (IO a)
instance HasGetter GettableStateVar where
get (GettableStateVar g) = liftIO g
makeGettableStateVar :: IO a -> GettableStateVar a
makeGettableStateVar = GettableStateVar
class HasSetter s where
($=) :: MonadGL m => s a -> a -> m ()
set :: MonadGL m => [IO ()] -> m ()
set = liftIO . sequence_
newtype SettableStateVar a = SettableStateVar (a -> IO ())
instance HasSetter SettableStateVar where
($=) (SettableStateVar s) a = liftIO $ s a
($=!) :: (HasSetter s, MonadGL m) => s a -> a -> m ()
v $=! x = x `seq` v $= x
makeSettableStateVar :: (a -> IO ()) -> SettableStateVar a
makeSettableStateVar = SettableStateVar
data StateVar a =
StateVar (GettableStateVar a) (SettableStateVar a)
instance HasGetter StateVar where
get (StateVar g _) = get g
instance HasSetter StateVar where
($=) (StateVar _ s) a = s $= a
makeStateVar :: IO a -> (a -> IO ()) -> StateVar a
makeStateVar g s = StateVar (makeGettableStateVar g) (makeSettableStateVar s)
($~) :: (HasGetter v, HasSetter v, MonadGL m) => v a -> (a -> a) -> m ()
v $~ f = do
x <- get v
v $= f x
($~!) :: (HasGetter v, HasSetter v, MonadGL m) => v a -> (a -> a) -> m ()
v $~! f = do
x <- get v
v $=! f x
instance HasGetter IORef where
get = liftIO . readIORef
instance HasSetter IORef where
($=) a b = liftIO $ writeIORef a b