module Graphics.Rendering.OpenGL.GL.DisplayLists (
DisplayList(DisplayList), ListMode(..), defineList, defineNewList, listIndex,
listMode, maxListNesting,
callList, callLists, listBase
) where
import Control.Monad.IO.Class
import Data.ObjectName
import Data.StateVar
import Foreign.Ptr ( Ptr )
import Graphics.Rendering.OpenGL.GL.DebugOutput
import Graphics.Rendering.OpenGL.GL.DataType
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL
newtype DisplayList = DisplayList { DisplayList -> GLenum
displayListID :: GLuint }
deriving ( DisplayList -> DisplayList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayList -> DisplayList -> Bool
$c/= :: DisplayList -> DisplayList -> Bool
== :: DisplayList -> DisplayList -> Bool
$c== :: DisplayList -> DisplayList -> Bool
Eq, Eq DisplayList
DisplayList -> DisplayList -> Bool
DisplayList -> DisplayList -> Ordering
DisplayList -> DisplayList -> DisplayList
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 :: DisplayList -> DisplayList -> DisplayList
$cmin :: DisplayList -> DisplayList -> DisplayList
max :: DisplayList -> DisplayList -> DisplayList
$cmax :: DisplayList -> DisplayList -> DisplayList
>= :: DisplayList -> DisplayList -> Bool
$c>= :: DisplayList -> DisplayList -> Bool
> :: DisplayList -> DisplayList -> Bool
$c> :: DisplayList -> DisplayList -> Bool
<= :: DisplayList -> DisplayList -> Bool
$c<= :: DisplayList -> DisplayList -> Bool
< :: DisplayList -> DisplayList -> Bool
$c< :: DisplayList -> DisplayList -> Bool
compare :: DisplayList -> DisplayList -> Ordering
$ccompare :: DisplayList -> DisplayList -> Ordering
Ord, Int -> DisplayList -> ShowS
[DisplayList] -> ShowS
DisplayList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayList] -> ShowS
$cshowList :: [DisplayList] -> ShowS
show :: DisplayList -> String
$cshow :: DisplayList -> String
showsPrec :: Int -> DisplayList -> ShowS
$cshowsPrec :: Int -> DisplayList -> ShowS
Show )
instance ObjectName DisplayList where
isObjectName :: forall (m :: * -> *). MonadIO m => DisplayList -> m Bool
isObjectName = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => GLenum -> m GLboolean
glIsList forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID
deleteObjectNames :: forall (m :: * -> *). MonadIO m => [DisplayList] -> m ()
deleteObjectNames =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadIO m => GLenum -> GLsizei -> m ()
glDeleteLists) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DisplayList] -> [(GLenum, GLsizei)]
combineConsecutive
instance CanBeLabeled DisplayList where
objectLabel :: DisplayList -> StateVar (Maybe String)
objectLabel = GLenum -> GLenum -> StateVar (Maybe String)
objectNameLabel GLenum
GL_DISPLAY_LIST forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID
combineConsecutive :: [DisplayList] -> [(GLuint, GLsizei)]
combineConsecutive :: [DisplayList] -> [(GLenum, GLsizei)]
combineConsecutive [] = []
combineConsecutive (DisplayList
z:[DisplayList]
zs) = (DisplayList -> GLenum
displayListID DisplayList
z, GLsizei
len) forall a. a -> [a] -> [a]
: [DisplayList] -> [(GLenum, GLsizei)]
combineConsecutive [DisplayList]
rest
where (GLsizei
len, [DisplayList]
rest) = forall {t}.
Num t =>
t -> DisplayList -> [DisplayList] -> (t, [DisplayList])
run (GLsizei
0 :: GLsizei) DisplayList
z [DisplayList]
zs
run :: t -> DisplayList -> [DisplayList] -> (t, [DisplayList])
run t
n DisplayList
x [DisplayList]
xs = case t
n forall a. Num a => a -> a -> a
+ t
1 of
t
m -> case [DisplayList]
xs of
[] -> (t
m, [])
(DisplayList
y:[DisplayList]
ys) | DisplayList
x DisplayList -> DisplayList -> Bool
`isFollowedBy` DisplayList
y -> t -> DisplayList -> [DisplayList] -> (t, [DisplayList])
run t
m DisplayList
y [DisplayList]
ys
| Bool
otherwise -> (t
m, [DisplayList]
xs)
DisplayList GLenum
x isFollowedBy :: DisplayList -> DisplayList -> Bool
`isFollowedBy` DisplayList GLenum
y = GLenum
x forall a. Num a => a -> a -> a
+ GLenum
1 forall a. Eq a => a -> a -> Bool
== GLenum
y
instance GeneratableObjectName DisplayList where
genObjectNames :: forall (m :: * -> *). MonadIO m => Int -> m [DisplayList]
genObjectNames Int
n = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
GLenum
first <- forall (m :: * -> *). MonadIO m => GLsizei -> m GLenum
glGenLists (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
if GLenum -> DisplayList
DisplayList GLenum
first forall a. Eq a => a -> a -> Bool
== DisplayList
noDisplayList
then do IO ()
recordOutOfMemory
forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) a. Monad m => a -> m a
return [ GLenum -> DisplayList
DisplayList GLenum
l
| GLenum
l <- [ GLenum
first .. GLenum
first forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- GLenum
1 ] ]
data ListMode =
Compile
| CompileAndExecute
deriving ( ListMode -> ListMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMode -> ListMode -> Bool
$c/= :: ListMode -> ListMode -> Bool
== :: ListMode -> ListMode -> Bool
$c== :: ListMode -> ListMode -> Bool
Eq, Eq ListMode
ListMode -> ListMode -> Bool
ListMode -> ListMode -> Ordering
ListMode -> ListMode -> ListMode
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 :: ListMode -> ListMode -> ListMode
$cmin :: ListMode -> ListMode -> ListMode
max :: ListMode -> ListMode -> ListMode
$cmax :: ListMode -> ListMode -> ListMode
>= :: ListMode -> ListMode -> Bool
$c>= :: ListMode -> ListMode -> Bool
> :: ListMode -> ListMode -> Bool
$c> :: ListMode -> ListMode -> Bool
<= :: ListMode -> ListMode -> Bool
$c<= :: ListMode -> ListMode -> Bool
< :: ListMode -> ListMode -> Bool
$c< :: ListMode -> ListMode -> Bool
compare :: ListMode -> ListMode -> Ordering
$ccompare :: ListMode -> ListMode -> Ordering
Ord, Int -> ListMode -> ShowS
[ListMode] -> ShowS
ListMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMode] -> ShowS
$cshowList :: [ListMode] -> ShowS
show :: ListMode -> String
$cshow :: ListMode -> String
showsPrec :: Int -> ListMode -> ShowS
$cshowsPrec :: Int -> ListMode -> ShowS
Show )
marshalListMode :: ListMode -> GLenum
marshalListMode :: ListMode -> GLenum
marshalListMode ListMode
x = case ListMode
x of
ListMode
Compile -> GLenum
GL_COMPILE
ListMode
CompileAndExecute -> GLenum
GL_COMPILE_AND_EXECUTE
unmarshalListMode :: GLenum -> ListMode
unmarshalListMode :: GLenum -> ListMode
unmarshalListMode GLenum
x
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPILE = ListMode
Compile
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPILE_AND_EXECUTE = ListMode
CompileAndExecute
| Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalListMode: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)
defineList :: DisplayList -> ListMode -> IO a -> IO a
defineList :: forall a. DisplayList -> ListMode -> IO a -> IO a
defineList DisplayList
dl ListMode
mode =
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glNewList (DisplayList -> GLenum
displayListID DisplayList
dl) (ListMode -> GLenum
marshalListMode ListMode
mode)) forall (m :: * -> *). MonadIO m => m ()
glEndList
defineNewList :: ListMode -> IO a -> IO DisplayList
defineNewList :: forall a. ListMode -> IO a -> IO DisplayList
defineNewList ListMode
mode IO a
action = do
DisplayList
lst <- forall a (m :: * -> *). (GeneratableObjectName a, MonadIO m) => m a
genObjectName
a
_ <- forall a. DisplayList -> ListMode -> IO a -> IO a
defineList DisplayList
lst ListMode
mode IO a
action
forall (m :: * -> *) a. Monad m => a -> m a
return DisplayList
lst
listIndex :: GettableStateVar (Maybe DisplayList)
listIndex :: GettableStateVar (Maybe DisplayList)
listIndex =
forall a. IO a -> IO a
makeGettableStateVar
(do DisplayList
l <- forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 (GLenum -> DisplayList
DisplayList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) PName1I
GetListIndex
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if DisplayList
l forall a. Eq a => a -> a -> Bool
== DisplayList
noDisplayList then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just DisplayList
l)
noDisplayList :: DisplayList
noDisplayList :: DisplayList
noDisplayList = GLenum -> DisplayList
DisplayList GLenum
0
listMode :: GettableStateVar ListMode
listMode :: GettableStateVar ListMode
listMode = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ListMode
unmarshalListMode PName1I
GetListMode)
maxListNesting :: GettableStateVar GLsizei
maxListNesting :: GettableStateVar GLsizei
maxListNesting = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 forall a. a -> a
id PName1I
GetMaxListNesting)
callList :: DisplayList -> IO ()
callList :: DisplayList -> IO ()
callList = forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCallList forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID
callLists :: GLsizei -> DataType -> Ptr a -> IO ()
callLists :: forall a. GLsizei -> DataType -> Ptr a -> IO ()
callLists GLsizei
n = forall (m :: * -> *) a.
MonadIO m =>
GLsizei -> GLenum -> Ptr a -> m ()
glCallLists GLsizei
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> GLenum
marshalDataType
listBase :: StateVar DisplayList
listBase :: StateVar DisplayList
listBase =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 (GLenum -> DisplayList
DisplayList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) PName1I
GetListBase)
(forall (m :: * -> *). MonadIO m => GLenum -> m ()
glListBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID)