--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- 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
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)