--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OGL.GL.StateVar
-- Copyright   :  (c) Sven Panne 2002-2006
-- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
-- 
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  stable
-- Portability :  portable
--
--------------------------------------------------------------------------------

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
--------------------------------------------------------------------------------
-- | compatibility: '$=' in the IO monad.
($$=) :: HasSetter g => g a -> a -> IO ()
($$=) x y = runGL (x $= y)

-- | compatibility: 'get' in the IO monad.
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 ()

{-# DEPRECATED set "use `sequence_' instead" #-}
set :: MonadGL m => [IO ()] -> m ()
set = liftIO . sequence_

--------------------------------------------------------------------------------

newtype SettableStateVar a = SettableStateVar (a -> IO ())

instance HasSetter SettableStateVar where
   ($=) (SettableStateVar s) a = liftIO $ s a

-- | A strict variant of '$='.
($=!) :: (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)

--------------------------------------------------------------------------------

-- | A modificator convenience function.

($~) :: (HasGetter v, HasSetter v, MonadGL m) => v a -> (a -> a) -> m ()
v $~ f = do
   x <- get v
   v $= f x

-- | A strict variant of '$~'.
($~!) :: (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