module Graphics.Rendering.OpenGL.GL.DisplayLists (
DisplayList(..), ListMode(..), defineList, defineNewList, listIndex,
listMode, maxListNesting,
callList, callLists, listBase,
genLists, deleteLists, isList,
) where
import Data.ObjectName
import Data.StateVar
import Foreign.Ptr
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.Rendering.OpenGL.Raw.ARB.Compatibility (
glCallList, glCallLists, glDeleteLists, glEndList, glGenLists, glIsList,
glListBase, glNewList, gl_COMPILE, gl_COMPILE_AND_EXECUTE )
import Graphics.Rendering.OpenGL.Raw.Core31
newtype DisplayList = DisplayList GLuint
deriving ( Eq, Ord, Show )
instance ObjectName DisplayList where
genObjectNames = genLists_
deleteObjectNames = deleteLists_
isObjectName = isList_
genLists :: GLsizei -> IO [DisplayList]
genLists = genLists_ . fromIntegral
genLists_ :: Int -> IO [DisplayList]
genLists_ n = do
first <- glGenLists (fromIntegral n)
if DisplayList first == noDisplayList
then do recordOutOfMemory
return []
else return [ DisplayList l | l <- [ first .. first + fromIntegral n 1 ] ]
deleteLists :: [DisplayList] -> IO ()
deleteLists = deleteLists_
deleteLists_ :: [DisplayList] -> IO ()
deleteLists_ = mapM_ (uncurry glDeleteLists) . combineConsecutive
combineConsecutive :: [DisplayList] -> [(GLuint, GLsizei)]
combineConsecutive [] = []
combineConsecutive (z@(DisplayList dl) :zs) = (dl, len) : combineConsecutive rest
where (len, rest) = run (0 :: GLsizei) z zs
run n x xs = case n + 1 of
m -> case xs of
[] -> (m, [])
(y:ys) | x `isFollowedBy` y -> run m y ys
| otherwise -> (m, xs)
DisplayList x `isFollowedBy` DisplayList y = x + 1 == y
isList :: DisplayList -> IO Bool
isList = isList_
isList_ :: DisplayList -> IO Bool
isList_ (DisplayList dl) = fmap unmarshalGLboolean (glIsList dl)
data ListMode =
Compile
| CompileAndExecute
deriving ( Eq, Ord, Show )
marshalListMode :: ListMode -> GLenum
marshalListMode x = case x of
Compile -> gl_COMPILE
CompileAndExecute -> gl_COMPILE_AND_EXECUTE
unmarshalListMode :: GLenum -> ListMode
unmarshalListMode x
| x == gl_COMPILE = Compile
| x == gl_COMPILE_AND_EXECUTE = CompileAndExecute
| otherwise = error ("unmarshalListMode: illegal value " ++ show x)
defineList :: DisplayList -> ListMode -> IO a -> IO a
defineList (DisplayList dl) mode = bracket_ (glNewList dl (marshalListMode mode)) glEndList
defineNewList :: ListMode -> IO a -> IO DisplayList
defineNewList mode action = do
lists <- genLists 1
if null lists
then do recordOutOfMemory
return noDisplayList
else do let lst = head lists
_ <- defineList lst mode action
return lst
listIndex :: GettableStateVar (Maybe DisplayList)
listIndex =
makeGettableStateVar
(do l <- getEnum1 (DisplayList . fromIntegral) GetListIndex
return $ if l == noDisplayList then Nothing else Just l)
noDisplayList :: DisplayList
noDisplayList = DisplayList 0
listMode :: GettableStateVar ListMode
listMode = makeGettableStateVar (getEnum1 unmarshalListMode GetListMode)
maxListNesting :: GettableStateVar GLsizei
maxListNesting = makeGettableStateVar (getSizei1 id GetMaxListNesting)
callList :: DisplayList -> IO ()
callList (DisplayList dl) = glCallList dl
callLists :: GLsizei -> DataType -> Ptr a -> IO ()
callLists n = glCallLists n . marshalDataType
listBase :: StateVar DisplayList
listBase =
makeStateVar
(getEnum1 (DisplayList . fromIntegral) GetListBase)
(\(DisplayList dl) -> glListBase dl)