module Graphics.Rendering.OpenGL.GL.Selection (
HitRecord(..), getHitRecords,
Name(..), withName, loadName, maxNameStackDepth, nameStackDepth,
RenderMode(..), renderMode
) where
import Data.StateVar
import Foreign.Marshal.Array
import Foreign.Ptr
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.IOState
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.RenderMode
import Graphics.GL
data HitRecord = HitRecord GLfloat GLfloat [Name]
deriving ( HitRecord -> HitRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HitRecord -> HitRecord -> Bool
$c/= :: HitRecord -> HitRecord -> Bool
== :: HitRecord -> HitRecord -> Bool
$c== :: HitRecord -> HitRecord -> Bool
Eq, Eq HitRecord
HitRecord -> HitRecord -> Bool
HitRecord -> HitRecord -> Ordering
HitRecord -> HitRecord -> HitRecord
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 :: HitRecord -> HitRecord -> HitRecord
$cmin :: HitRecord -> HitRecord -> HitRecord
max :: HitRecord -> HitRecord -> HitRecord
$cmax :: HitRecord -> HitRecord -> HitRecord
>= :: HitRecord -> HitRecord -> Bool
$c>= :: HitRecord -> HitRecord -> Bool
> :: HitRecord -> HitRecord -> Bool
$c> :: HitRecord -> HitRecord -> Bool
<= :: HitRecord -> HitRecord -> Bool
$c<= :: HitRecord -> HitRecord -> Bool
< :: HitRecord -> HitRecord -> Bool
$c< :: HitRecord -> HitRecord -> Bool
compare :: HitRecord -> HitRecord -> Ordering
$ccompare :: HitRecord -> HitRecord -> Ordering
Ord, Int -> HitRecord -> ShowS
[HitRecord] -> ShowS
HitRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HitRecord] -> ShowS
$cshowList :: [HitRecord] -> ShowS
show :: HitRecord -> String
$cshow :: HitRecord -> String
showsPrec :: Int -> HitRecord -> ShowS
$cshowsPrec :: Int -> HitRecord -> ShowS
Show )
getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])
getHitRecords :: forall a. GLint -> IO a -> IO (a, Maybe [HitRecord])
getHitRecords GLint
bufSize IO a
action =
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
bufSize) forall a b. (a -> b) -> a -> b
$ \Ptr GLuint
buf -> do
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glSelectBuffer GLint
bufSize Ptr GLuint
buf
(a
value, GLint
numHits) <- forall a. RenderMode -> IO a -> IO (a, GLint)
withRenderMode RenderMode
Select forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => m ()
glInitNames
IO a
action
Maybe [HitRecord]
hits <- GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
parseSelectionBuffer GLint
numHits Ptr GLuint
buf
forall (m :: * -> *) a. Monad m => a -> m a
return (a
value, Maybe [HitRecord]
hits)
parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
parseSelectionBuffer GLint
numHits Ptr GLuint
buf
| GLint
numHits forall a. Ord a => a -> a -> Bool
< GLint
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s a. IOState s a -> Ptr s -> IO a
evalIOState (forall a b c. Integral a => a -> IOState b c -> IOState b [c]
nTimes GLint
numHits Parser HitRecord
parseSelectionHit) Ptr GLuint
buf
type Parser a = IOState GLuint a
parseSelectionHit :: Parser HitRecord
parseSelectionHit :: Parser HitRecord
parseSelectionHit = do
GLuint
numNames <- Parser GLuint
parseGLuint
GLfloat
minZ <- Parser GLfloat
parseGLfloat
GLfloat
maxZ <- Parser GLfloat
parseGLfloat
[Name]
nameStack <- forall a b c. Integral a => a -> IOState b c -> IOState b [c]
nTimes GLuint
numNames Parser Name
parseName
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GLfloat -> GLfloat -> [Name] -> HitRecord
HitRecord GLfloat
minZ GLfloat
maxZ [Name]
nameStack
parseGLuint :: Parser GLuint
parseGLuint :: Parser GLuint
parseGLuint = forall a. Storable a => IOState a a
peekIOState
parseGLfloat :: Parser GLfloat
parseGLfloat :: Parser GLfloat
parseGLfloat = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GLuint
x -> forall a b. (Integral a, Num b) => a -> b
fromIntegral GLuint
x forall a. Fractional a => a -> a -> a
/ GLfloat
0xffffffff) Parser GLuint
parseGLuint
parseName :: Parser Name
parseName :: Parser Name
parseName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLuint -> Name
Name Parser GLuint
parseGLuint
newtype Name = Name GLuint
deriving ( Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show )
withName :: Name -> IO a -> IO a
withName :: forall a. Name -> IO a -> IO a
withName (Name GLuint
name) = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *). MonadIO m => GLuint -> m ()
glPushName GLuint
name) forall (m :: * -> *). MonadIO m => m ()
glPopName
loadName :: Name -> IO ()
loadName :: Name -> IO ()
loadName (Name GLuint
n) = forall (m :: * -> *). MonadIO m => GLuint -> m ()
glLoadName GLuint
n
maxNameStackDepth :: GettableStateVar GLsizei
maxNameStackDepth :: GettableStateVar GLint
maxNameStackDepth = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getSizei1 forall a. a -> a
id PName1I
GetMaxNameStackDepth)
nameStackDepth :: GettableStateVar GLsizei
nameStackDepth :: GettableStateVar GLint
nameStackDepth = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getSizei1 forall a. a -> a
id PName1I
GetNameStackDepth)