--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.SavingState
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
-- 
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 6.1.14 (Saving and Restoring State) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.SavingState (
   ServerAttributeGroup(..), preservingAttrib,
   ClientAttributeGroup(..), preservingClientAttrib
) where

import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )
import Graphics.GL

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

data ServerAttributeGroup =
     CurrentAttributes
   | PointAttributes
   | LineAttributes
   | PolygonAttributes
   | PolygonStippleAttributes
   | PixelModeAttributes
   | LightingAttributes
   | FogAttributes
   | DepthBufferAttributes
   | AccumBufferAttributes
   | StencilBufferAttributes
   | ViewportAttributes
   | TransformAttributes
   | EnableAttributes
   | ColorBufferAttributes
   | HintAttributes
   | EvalAttributes
   | ListAttributes
   | TextureAttributes
   | ScissorAttributes
   | MultisampleAttributes
   | AllServerAttributes
   deriving ( ServerAttributeGroup -> ServerAttributeGroup -> Bool
(ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> (ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> Eq ServerAttributeGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c/= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
== :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c== :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
Eq, Eq ServerAttributeGroup
Eq ServerAttributeGroup
-> (ServerAttributeGroup -> ServerAttributeGroup -> Ordering)
-> (ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> (ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> (ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> (ServerAttributeGroup -> ServerAttributeGroup -> Bool)
-> (ServerAttributeGroup
    -> ServerAttributeGroup -> ServerAttributeGroup)
-> (ServerAttributeGroup
    -> ServerAttributeGroup -> ServerAttributeGroup)
-> Ord ServerAttributeGroup
ServerAttributeGroup -> ServerAttributeGroup -> Bool
ServerAttributeGroup -> ServerAttributeGroup -> Ordering
ServerAttributeGroup
-> ServerAttributeGroup -> ServerAttributeGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ServerAttributeGroup
-> ServerAttributeGroup -> ServerAttributeGroup
$cmin :: ServerAttributeGroup
-> ServerAttributeGroup -> ServerAttributeGroup
max :: ServerAttributeGroup
-> ServerAttributeGroup -> ServerAttributeGroup
$cmax :: ServerAttributeGroup
-> ServerAttributeGroup -> ServerAttributeGroup
>= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c>= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
> :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c> :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
<= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c<= :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
< :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
$c< :: ServerAttributeGroup -> ServerAttributeGroup -> Bool
compare :: ServerAttributeGroup -> ServerAttributeGroup -> Ordering
$ccompare :: ServerAttributeGroup -> ServerAttributeGroup -> Ordering
$cp1Ord :: Eq ServerAttributeGroup
Ord, Int -> ServerAttributeGroup -> ShowS
[ServerAttributeGroup] -> ShowS
ServerAttributeGroup -> String
(Int -> ServerAttributeGroup -> ShowS)
-> (ServerAttributeGroup -> String)
-> ([ServerAttributeGroup] -> ShowS)
-> Show ServerAttributeGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerAttributeGroup] -> ShowS
$cshowList :: [ServerAttributeGroup] -> ShowS
show :: ServerAttributeGroup -> String
$cshow :: ServerAttributeGroup -> String
showsPrec :: Int -> ServerAttributeGroup -> ShowS
$cshowsPrec :: Int -> ServerAttributeGroup -> ShowS
Show )

marshalServerAttributeGroup :: ServerAttributeGroup -> GLbitfield
marshalServerAttributeGroup :: ServerAttributeGroup -> GLbitfield
marshalServerAttributeGroup ServerAttributeGroup
x = case ServerAttributeGroup
x of
   ServerAttributeGroup
CurrentAttributes -> GLbitfield
GL_CURRENT_BIT
   ServerAttributeGroup
PointAttributes -> GLbitfield
GL_POINT_BIT
   ServerAttributeGroup
LineAttributes -> GLbitfield
GL_LINE_BIT
   ServerAttributeGroup
PolygonAttributes -> GLbitfield
GL_POLYGON_BIT
   ServerAttributeGroup
PolygonStippleAttributes -> GLbitfield
GL_POLYGON_STIPPLE_BIT
   ServerAttributeGroup
PixelModeAttributes -> GLbitfield
GL_PIXEL_MODE_BIT
   ServerAttributeGroup
LightingAttributes -> GLbitfield
GL_LIGHTING_BIT
   ServerAttributeGroup
FogAttributes -> GLbitfield
GL_FOG_BIT
   ServerAttributeGroup
DepthBufferAttributes -> GLbitfield
GL_DEPTH_BUFFER_BIT
   ServerAttributeGroup
AccumBufferAttributes -> GLbitfield
GL_ACCUM_BUFFER_BIT
   ServerAttributeGroup
StencilBufferAttributes -> GLbitfield
GL_STENCIL_BUFFER_BIT
   ServerAttributeGroup
ViewportAttributes -> GLbitfield
GL_VIEWPORT_BIT
   ServerAttributeGroup
TransformAttributes -> GLbitfield
GL_TRANSFORM_BIT
   ServerAttributeGroup
EnableAttributes -> GLbitfield
GL_ENABLE_BIT
   ServerAttributeGroup
ColorBufferAttributes -> GLbitfield
GL_COLOR_BUFFER_BIT
   ServerAttributeGroup
HintAttributes -> GLbitfield
GL_HINT_BIT
   ServerAttributeGroup
EvalAttributes -> GLbitfield
GL_EVAL_BIT
   ServerAttributeGroup
ListAttributes -> GLbitfield
GL_LIST_BIT
   ServerAttributeGroup
TextureAttributes -> GLbitfield
GL_TEXTURE_BIT
   ServerAttributeGroup
ScissorAttributes -> GLbitfield
GL_SCISSOR_BIT
   ServerAttributeGroup
MultisampleAttributes -> GLbitfield
GL_MULTISAMPLE_BIT
   ServerAttributeGroup
AllServerAttributes -> GLbitfield
GL_ALL_ATTRIB_BITS

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

preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a
preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a
preservingAttrib [ServerAttributeGroup]
groups = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ ([ServerAttributeGroup] -> IO ()
pushAttrib [ServerAttributeGroup]
groups) IO ()
forall (m :: * -> *). MonadIO m => m ()
glPopAttrib

pushAttrib :: [ServerAttributeGroup] -> IO ()
pushAttrib :: [ServerAttributeGroup] -> IO ()
pushAttrib = GLbitfield -> IO ()
forall (m :: * -> *). MonadIO m => GLbitfield -> m ()
glPushAttrib (GLbitfield -> IO ())
-> ([ServerAttributeGroup] -> GLbitfield)
-> [ServerAttributeGroup]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GLbitfield] -> GLbitfield
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([GLbitfield] -> GLbitfield)
-> ([ServerAttributeGroup] -> [GLbitfield])
-> [ServerAttributeGroup]
-> GLbitfield
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerAttributeGroup -> GLbitfield)
-> [ServerAttributeGroup] -> [GLbitfield]
forall a b. (a -> b) -> [a] -> [b]
map ServerAttributeGroup -> GLbitfield
marshalServerAttributeGroup

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

data ClientAttributeGroup =
     PixelStoreAttributes
   | VertexArrayAttributes
   | AllClientAttributes
   deriving ( ClientAttributeGroup -> ClientAttributeGroup -> Bool
(ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> (ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> Eq ClientAttributeGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c/= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
== :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c== :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
Eq, Eq ClientAttributeGroup
Eq ClientAttributeGroup
-> (ClientAttributeGroup -> ClientAttributeGroup -> Ordering)
-> (ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> (ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> (ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> (ClientAttributeGroup -> ClientAttributeGroup -> Bool)
-> (ClientAttributeGroup
    -> ClientAttributeGroup -> ClientAttributeGroup)
-> (ClientAttributeGroup
    -> ClientAttributeGroup -> ClientAttributeGroup)
-> Ord ClientAttributeGroup
ClientAttributeGroup -> ClientAttributeGroup -> Bool
ClientAttributeGroup -> ClientAttributeGroup -> Ordering
ClientAttributeGroup
-> ClientAttributeGroup -> ClientAttributeGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClientAttributeGroup
-> ClientAttributeGroup -> ClientAttributeGroup
$cmin :: ClientAttributeGroup
-> ClientAttributeGroup -> ClientAttributeGroup
max :: ClientAttributeGroup
-> ClientAttributeGroup -> ClientAttributeGroup
$cmax :: ClientAttributeGroup
-> ClientAttributeGroup -> ClientAttributeGroup
>= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c>= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
> :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c> :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
<= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c<= :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
< :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
$c< :: ClientAttributeGroup -> ClientAttributeGroup -> Bool
compare :: ClientAttributeGroup -> ClientAttributeGroup -> Ordering
$ccompare :: ClientAttributeGroup -> ClientAttributeGroup -> Ordering
$cp1Ord :: Eq ClientAttributeGroup
Ord, Int -> ClientAttributeGroup -> ShowS
[ClientAttributeGroup] -> ShowS
ClientAttributeGroup -> String
(Int -> ClientAttributeGroup -> ShowS)
-> (ClientAttributeGroup -> String)
-> ([ClientAttributeGroup] -> ShowS)
-> Show ClientAttributeGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientAttributeGroup] -> ShowS
$cshowList :: [ClientAttributeGroup] -> ShowS
show :: ClientAttributeGroup -> String
$cshow :: ClientAttributeGroup -> String
showsPrec :: Int -> ClientAttributeGroup -> ShowS
$cshowsPrec :: Int -> ClientAttributeGroup -> ShowS
Show )

marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield
marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield
marshalClientAttributeGroup ClientAttributeGroup
x = case ClientAttributeGroup
x of
   ClientAttributeGroup
PixelStoreAttributes -> GLbitfield
GL_CLIENT_PIXEL_STORE_BIT
   ClientAttributeGroup
VertexArrayAttributes -> GLbitfield
GL_CLIENT_VERTEX_ARRAY_BIT
   ClientAttributeGroup
AllClientAttributes -> GLbitfield
GL_CLIENT_ALL_ATTRIB_BITS

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

preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a
preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a
preservingClientAttrib [ClientAttributeGroup]
groups =
   IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ ([ClientAttributeGroup] -> IO ()
pushClientAttrib [ClientAttributeGroup]
groups) IO ()
forall (m :: * -> *). MonadIO m => m ()
glPopClientAttrib

pushClientAttrib :: [ClientAttributeGroup] -> IO ()
pushClientAttrib :: [ClientAttributeGroup] -> IO ()
pushClientAttrib = GLbitfield -> IO ()
forall (m :: * -> *). MonadIO m => GLbitfield -> m ()
glPushClientAttrib (GLbitfield -> IO ())
-> ([ClientAttributeGroup] -> GLbitfield)
-> [ClientAttributeGroup]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GLbitfield] -> GLbitfield
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([GLbitfield] -> GLbitfield)
-> ([ClientAttributeGroup] -> [GLbitfield])
-> [ClientAttributeGroup]
-> GLbitfield
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientAttributeGroup -> GLbitfield)
-> [ClientAttributeGroup] -> [GLbitfield]
forall a b. (a -> b) -> [a] -> [b]
map ClientAttributeGroup -> GLbitfield
marshalClientAttributeGroup