--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <[email protected]>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 5.4 (Display Lists) of the OpenGL 2.1
-- specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.DisplayLists (
   -- * Defining Display Lists
   DisplayList(DisplayList), ListMode(..), defineList, defineNewList, listIndex,
   listMode, maxListNesting,

   -- * Calling Display Lists
   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
(DisplayList -> DisplayList -> Bool)
-> (DisplayList -> DisplayList -> Bool) -> Eq DisplayList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplayList -> DisplayList -> Bool
== :: DisplayList -> DisplayList -> Bool
$c/= :: DisplayList -> DisplayList -> Bool
/= :: DisplayList -> DisplayList -> Bool
Eq, Eq DisplayList
Eq DisplayList =>
(DisplayList -> DisplayList -> Ordering)
-> (DisplayList -> DisplayList -> Bool)
-> (DisplayList -> DisplayList -> Bool)
-> (DisplayList -> DisplayList -> Bool)
-> (DisplayList -> DisplayList -> Bool)
-> (DisplayList -> DisplayList -> DisplayList)
-> (DisplayList -> DisplayList -> DisplayList)
-> Ord 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
$ccompare :: DisplayList -> DisplayList -> Ordering
compare :: DisplayList -> DisplayList -> Ordering
$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
>= :: DisplayList -> DisplayList -> Bool
$cmax :: DisplayList -> DisplayList -> DisplayList
max :: DisplayList -> DisplayList -> DisplayList
$cmin :: DisplayList -> DisplayList -> DisplayList
min :: DisplayList -> DisplayList -> DisplayList
Ord, Int -> DisplayList -> ShowS
[DisplayList] -> ShowS
DisplayList -> String
(Int -> DisplayList -> ShowS)
-> (DisplayList -> String)
-> ([DisplayList] -> ShowS)
-> Show DisplayList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayList -> ShowS
showsPrec :: Int -> DisplayList -> ShowS
$cshow :: DisplayList -> String
show :: DisplayList -> String
$cshowList :: [DisplayList] -> ShowS
showList :: [DisplayList] -> ShowS
Show )

instance ObjectName DisplayList where
   isObjectName :: forall (m :: * -> *). MonadIO m => DisplayList -> m Bool
isObjectName = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> (DisplayList -> IO Bool) -> DisplayList -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLboolean -> Bool) -> IO GLboolean -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean (IO GLboolean -> IO Bool)
-> (DisplayList -> IO GLboolean) -> DisplayList -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> IO GLboolean
forall (m :: * -> *). MonadIO m => GLenum -> m GLboolean
glIsList (GLenum -> IO GLboolean)
-> (DisplayList -> GLenum) -> DisplayList -> IO GLboolean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID
   deleteObjectNames :: forall (m :: * -> *). MonadIO m => [DisplayList] -> m ()
deleteObjectNames =
     IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ([DisplayList] -> IO ()) -> [DisplayList] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GLenum, GLsizei) -> IO ()) -> [(GLenum, GLsizei)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((GLenum -> GLsizei -> IO ()) -> (GLenum, GLsizei) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GLenum -> GLsizei -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLsizei -> m ()
glDeleteLists) ([(GLenum, GLsizei)] -> IO ())
-> ([DisplayList] -> [(GLenum, GLsizei)]) -> [DisplayList] -> IO ()
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 (GLenum -> StateVar (Maybe String))
-> (DisplayList -> GLenum)
-> DisplayList
-> StateVar (Maybe String)
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) (GLenum, GLsizei) -> [(GLenum, GLsizei)] -> [(GLenum, GLsizei)]
forall a. a -> [a] -> [a]
: [DisplayList] -> [(GLenum, GLsizei)]
combineConsecutive [DisplayList]
rest
   where (GLsizei
len, [DisplayList]
rest) = GLsizei -> DisplayList -> [DisplayList] -> (GLsizei, [DisplayList])
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 t -> t -> t
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 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLenum
1 GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
y

instance GeneratableObjectName DisplayList where
   genObjectNames :: forall (m :: * -> *). MonadIO m => Int -> m [DisplayList]
genObjectNames Int
n = IO [DisplayList] -> m [DisplayList]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DisplayList] -> m [DisplayList])
-> IO [DisplayList] -> m [DisplayList]
forall a b. (a -> b) -> a -> b
$ do
      first <- GLsizei -> IO GLenum
forall (m :: * -> *). MonadIO m => GLsizei -> m GLenum
glGenLists (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      if DisplayList first == noDisplayList
         then do recordOutOfMemory
                 return []
         else return [ DisplayList l
                     | l <- [ first .. first + fromIntegral n - 1 ] ]

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

data ListMode =
     Compile
   | CompileAndExecute
   deriving ( ListMode -> ListMode -> Bool
(ListMode -> ListMode -> Bool)
-> (ListMode -> ListMode -> Bool) -> Eq ListMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListMode -> ListMode -> Bool
== :: ListMode -> ListMode -> Bool
$c/= :: ListMode -> ListMode -> Bool
/= :: ListMode -> ListMode -> Bool
Eq, Eq ListMode
Eq ListMode =>
(ListMode -> ListMode -> Ordering)
-> (ListMode -> ListMode -> Bool)
-> (ListMode -> ListMode -> Bool)
-> (ListMode -> ListMode -> Bool)
-> (ListMode -> ListMode -> Bool)
-> (ListMode -> ListMode -> ListMode)
-> (ListMode -> ListMode -> ListMode)
-> Ord 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
$ccompare :: ListMode -> ListMode -> Ordering
compare :: ListMode -> ListMode -> Ordering
$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
>= :: ListMode -> ListMode -> Bool
$cmax :: ListMode -> ListMode -> ListMode
max :: ListMode -> ListMode -> ListMode
$cmin :: ListMode -> ListMode -> ListMode
min :: ListMode -> ListMode -> ListMode
Ord, Int -> ListMode -> ShowS
[ListMode] -> ShowS
ListMode -> String
(Int -> ListMode -> ShowS)
-> (ListMode -> String) -> ([ListMode] -> ShowS) -> Show ListMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListMode -> ShowS
showsPrec :: Int -> ListMode -> ShowS
$cshow :: ListMode -> String
show :: ListMode -> String
$cshowList :: [ListMode] -> ShowS
showList :: [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 GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPILE = ListMode
Compile
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPILE_AND_EXECUTE = ListMode
CompileAndExecute
   | Bool
otherwise = String -> ListMode
forall a. HasCallStack => String -> a
error (String
"unmarshalListMode: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
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 =
   IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glNewList (DisplayList -> GLenum
displayListID DisplayList
dl) (ListMode -> GLenum
marshalListMode ListMode
mode)) IO ()
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
   lst <- IO DisplayList
forall a (m :: * -> *). (GeneratableObjectName a, MonadIO m) => m a
forall (m :: * -> *). MonadIO m => m DisplayList
genObjectName
   _ <- defineList lst mode action
   return lst

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

listIndex :: GettableStateVar (Maybe DisplayList)
listIndex :: GettableStateVar (Maybe DisplayList)
listIndex =
   GettableStateVar (Maybe DisplayList)
-> GettableStateVar (Maybe DisplayList)
forall a. IO a -> IO a
makeGettableStateVar
      (do l <- (GLenum -> DisplayList) -> PName1I -> IO DisplayList
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 (GLenum -> DisplayList
DisplayList (GLenum -> DisplayList)
-> (GLenum -> GLenum) -> GLenum -> DisplayList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PName1I
GetListIndex
          return $ if l == noDisplayList then Nothing else Just l)

noDisplayList :: DisplayList
noDisplayList :: DisplayList
noDisplayList = GLenum -> DisplayList
DisplayList GLenum
0

listMode :: GettableStateVar ListMode
listMode :: GettableStateVar ListMode
listMode = GettableStateVar ListMode -> GettableStateVar ListMode
forall a. IO a -> IO a
makeGettableStateVar ((GLenum -> ListMode) -> PName1I -> GettableStateVar ListMode
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 GLenum -> ListMode
unmarshalListMode PName1I
GetListMode)

maxListNesting :: GettableStateVar GLsizei
maxListNesting :: GettableStateVar GLsizei
maxListNesting = GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
forall a. (GLsizei -> a) -> PName1I -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxListNesting)

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

callList :: DisplayList -> IO ()
callList :: DisplayList -> IO ()
callList = GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCallList (GLenum -> IO ())
-> (DisplayList -> GLenum) -> DisplayList -> IO ()
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 = GLsizei -> GLenum -> Ptr a -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLsizei -> GLenum -> Ptr a -> m ()
glCallLists GLsizei
n (GLenum -> Ptr a -> IO ())
-> (DataType -> GLenum) -> DataType -> Ptr a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> GLenum
marshalDataType

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

listBase :: StateVar DisplayList
listBase :: StateVar DisplayList
listBase =
   IO DisplayList -> (DisplayList -> IO ()) -> StateVar DisplayList
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLenum -> DisplayList) -> PName1I -> IO DisplayList
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 (GLenum -> DisplayList
DisplayList (GLenum -> DisplayList)
-> (GLenum -> GLenum) -> GLenum -> DisplayList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PName1I
GetListBase)
      (GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glListBase (GLenum -> IO ())
-> (DisplayList -> GLenum) -> DisplayList -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayList -> GLenum
displayListID)