    --------------------------------------------------------------------------------
    -- |
    -- 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
    (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)