{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
module Typograffiti.GL where
import Control.Exception (assert)
import Control.Monad (forM_, replicateM, when)
import Control.Monad.Fail (MonadFail)
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Foldable as F
import qualified Data.Vector.Storable as SV
import Data.Vector.Unboxed (Unbox)
import qualified Data.Vector.Unboxed as UV
import Foreign.C.String (peekCAStringLen, withCString)
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import GHC.TypeLits (KnownNat)
import Graphics.GL.Core32
import Graphics.GL.Types
import Linear
import Linear.V (Finite, Size, dim, toV)
allocAndActivateTex :: (MonadIO m, MonadFail m) => GLenum -> m GLuint
allocAndActivateTex :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
GLenum -> m GLenum
allocAndActivateTex GLenum
u = do
[GLenum
t] <- IO [GLenum] -> m [GLenum]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GLenum] -> m [GLenum]) -> IO [GLenum] -> m [GLenum]
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
1 ((Ptr GLenum -> IO [GLenum]) -> IO [GLenum])
-> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
ptr -> do
GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLenum -> m ()
glGenTextures GLsizei
1 Ptr GLenum
ptr
Int -> Ptr GLenum -> IO [GLenum]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 Ptr GLenum
ptr
GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glActiveTexture GLenum
u
GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindTexture GLenum
forall {a}. (Eq a, Num a) => a
GL_TEXTURE_2D GLenum
t
GLenum -> m GLenum
forall (m :: * -> *) a. Monad m => a -> m a
return GLenum
t
clearErrors :: MonadIO m => String -> m ()
clearErrors :: forall (m :: * -> *). MonadIO m => String -> m ()
clearErrors String
str = do
GLenum
err' <- m GLenum
forall (m :: * -> *). MonadIO m => m GLenum
glGetError
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GLenum
err' GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
/= GLenum
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
str, GLenum -> String
forall a. Show a => a -> String
show GLenum
err']
Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newBoundVAO :: (MonadIO m, MonadFail m) => m GLuint
newBoundVAO :: forall (m :: * -> *). (MonadIO m, MonadFail m) => m GLenum
newBoundVAO = do
[GLenum
vao] <- IO [GLenum] -> m [GLenum]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GLenum] -> m [GLenum]) -> IO [GLenum] -> m [GLenum]
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
1 ((Ptr GLenum -> IO [GLenum]) -> IO [GLenum])
-> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
ptr -> do
GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLenum -> m ()
glGenVertexArrays GLsizei
1 Ptr GLenum
ptr
Int -> Ptr GLenum -> IO [GLenum]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 Ptr GLenum
ptr
GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
vao
GLenum -> m GLenum
forall (m :: * -> *) a. Monad m => a -> m a
return GLenum
vao
withVAO :: MonadIO m => (GLuint -> IO b) -> m b
withVAO :: forall (m :: * -> *) b. MonadIO m => (GLenum -> IO b) -> m b
withVAO GLenum -> IO b
f = IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ do
GLenum
vao <- IO GLenum
forall (m :: * -> *). (MonadIO m, MonadFail m) => m GLenum
newBoundVAO
b
r <- GLenum -> IO b
f GLenum
vao
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
clearErrors String
"withVAO"
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
0
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
newBuffer
:: MonadIO m
=> m GLuint
newBuffer :: forall (m :: * -> *). MonadIO m => m GLenum
newBuffer = IO GLenum -> m GLenum
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GLenum -> m GLenum) -> IO GLenum -> m GLenum
forall a b. (a -> b) -> a -> b
$ do
[GLenum
b] <- Int -> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
1 ((Ptr GLenum -> IO [GLenum]) -> IO [GLenum])
-> (Ptr GLenum -> IO [GLenum]) -> IO [GLenum]
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
ptr -> do
GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLenum -> m ()
glGenBuffers GLsizei
1 Ptr GLenum
ptr
Int -> Ptr GLenum -> IO [GLenum]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 Ptr GLenum
ptr
GLenum -> IO GLenum
forall (m :: * -> *) a. Monad m => a -> m a
return GLenum
b
withBuffers :: MonadIO m => Int -> ([GLuint] -> m b) -> m b
withBuffers :: forall (m :: * -> *) b.
MonadIO m =>
Int -> ([GLenum] -> m b) -> m b
withBuffers Int
n = (Int -> m GLenum -> m [GLenum]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n m GLenum
forall (m :: * -> *). MonadIO m => m GLenum
newBuffer m [GLenum] -> ([GLenum] -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
bufferGeometry
:: ( Foldable f
, Unbox (f Float)
, Storable (f Float)
, Finite f
, KnownNat (Size f)
, MonadIO m
)
=> GLuint
-> GLuint
-> UV.Vector (f Float)
-> m ()
bufferGeometry :: forall (f :: * -> *) (m :: * -> *).
(Foldable f, Unbox (f Float), Storable (f Float), Finite f,
KnownNat (Size f), MonadIO m) =>
GLenum -> GLenum -> Vector (f Float) -> m ()
bufferGeometry GLenum
loc GLenum
buf Vector (f Float)
as
| Vector (f Float) -> Bool
forall a. Unbox a => Vector a -> Bool
UV.null Vector (f Float)
as = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
let v :: f Float
v = Vector (f Float) -> f Float
forall a. Unbox a => Vector a -> a
UV.head Vector (f Float)
as
asize :: Int
asize = Vector (f Float) -> Int
forall a. Unbox a => Vector a -> Int
UV.length Vector (f Float)
as Int -> Int -> Int
forall a. Num a => a -> a -> a
* f Float -> Int
forall a. Storable a => a -> Int
sizeOf f Float
v
n :: GLsizei
n = Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizei) -> Int -> GLsizei
forall a b. (a -> b) -> a -> b
$ V (Size f) Float -> Int
forall {k} (n :: k) a. Dim n => V n a -> Int
dim (V (Size f) Float -> Int) -> V (Size f) Float -> Int
forall a b. (a -> b) -> a -> b
$ f Float -> V (Size f) Float
forall (v :: * -> *) a. Finite v => v a -> V (Size v) a
toV f Float
v
GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall {a}. (Eq a, Num a) => a
GL_ARRAY_BUFFER GLenum
buf
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Vector Float -> (Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
SV.unsafeWith (Vector (f Float) -> Vector Float
forall (f :: * -> *).
(Unbox (f Float), Foldable f) =>
Vector (f Float) -> Vector Float
convertVec Vector (f Float)
as) ((Ptr Float -> IO ()) -> IO ()) -> (Ptr Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Float
ptr ->
GLenum -> GLsizeiptr -> Ptr () -> GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizeiptr -> Ptr () -> GLenum -> m ()
glBufferData GLenum
forall {a}. (Eq a, Num a) => a
GL_ARRAY_BUFFER (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
asize) (Ptr Float -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
ptr) GLenum
forall {a}. (Eq a, Num a) => a
GL_STATIC_DRAW
GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnableVertexAttribArray GLenum
loc
GLenum
-> GLsizei -> GLenum -> GLboolean -> GLsizei -> Ptr () -> m ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLsizei -> GLenum -> GLboolean -> GLsizei -> Ptr () -> m ()
glVertexAttribPointer GLenum
loc GLsizei
n GLenum
forall {a}. (Eq a, Num a) => a
GL_FLOAT GLboolean
forall {a}. (Eq a, Num a) => a
GL_FALSE GLsizei
0 Ptr ()
forall a. Ptr a
nullPtr
String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
clearErrors String
"bufferGeometry"
convertVec
:: (Unbox (f Float), Foldable f) => UV.Vector (f Float) -> SV.Vector GLfloat
convertVec :: forall (f :: * -> *).
(Unbox (f Float), Foldable f) =>
Vector (f Float) -> Vector Float
convertVec =
Vector Float -> Vector Float
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
SV.convert (Vector Float -> Vector Float)
-> (Vector (f Float) -> Vector Float)
-> Vector (f Float)
-> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Vector Float -> Vector Float
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UV.map Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Vector Float -> Vector Float)
-> (Vector (f Float) -> Vector Float)
-> Vector (f Float)
-> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f Float -> Vector Float) -> Vector (f Float) -> Vector Float
forall a b.
(Unbox a, Unbox b) =>
(a -> Vector b) -> Vector a -> Vector b
UV.concatMap ([Float] -> Vector Float
forall a. Unbox a => [a] -> Vector a
UV.fromList ([Float] -> Vector Float)
-> (f Float -> [Float]) -> f Float -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Float -> [Float]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList)
withBoundTextures :: MonadIO m => [GLuint] -> m a -> m a
withBoundTextures :: forall (m :: * -> *) a. MonadIO m => [GLenum] -> m a -> m a
withBoundTextures [GLenum]
ts m a
f = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ((GLenum, GLenum) -> IO ()) -> [(GLenum, GLenum)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((GLenum -> GLenum -> IO ()) -> (GLenum, GLenum) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
bindTex) ([GLenum] -> [GLenum] -> [(GLenum, GLenum)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GLenum]
ts [GLenum
forall {a}. (Eq a, Num a) => a
GL_TEXTURE0 ..])
a
a <- m a
f
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindTexture GLenum
forall {a}. (Eq a, Num a) => a
GL_TEXTURE_2D GLenum
0
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
where bindTex :: GLenum -> GLenum -> m ()
bindTex GLenum
tex GLenum
u = GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glActiveTexture GLenum
u m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindTexture GLenum
forall {a}. (Eq a, Num a) => a
GL_TEXTURE_2D GLenum
tex
drawVAO
:: MonadIO m
=> GLuint
-> GLuint
-> GLenum
-> GLsizei
-> m ()
drawVAO :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLsizei -> m ()
drawVAO GLenum
program GLenum
vao GLenum
mode GLsizei
num = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glUseProgram GLenum
program
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
vao
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
clearErrors String
"drawBuffer:glBindVertex"
GLenum -> GLsizei -> GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> GLsizei -> m ()
glDrawArrays GLenum
mode GLsizei
0 GLsizei
num
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
clearErrors String
"drawBuffer:glDrawArrays"
compileOGLShader
:: MonadIO m
=> ByteString
-> GLenum
-> m (Either String GLuint)
compileOGLShader :: forall (m :: * -> *).
MonadIO m =>
ByteString -> GLenum -> m (Either String GLenum)
compileOGLShader ByteString
src GLenum
shType = do
GLenum
shader <- IO GLenum -> m GLenum
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GLenum -> m GLenum) -> IO GLenum -> m GLenum
forall a b. (a -> b) -> a -> b
$ GLenum -> IO GLenum
forall (m :: * -> *). MonadIO m => GLenum -> m GLenum
glCreateShader GLenum
shType
if GLenum
shader GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
0
then Either String GLenum -> m (Either String GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GLenum -> m (Either String GLenum))
-> Either String GLenum -> m (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ String -> Either String GLenum
forall a b. a -> Either a b
Left String
"Could not create shader"
else do
GLsizei
success <- IO GLsizei -> m GLsizei
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GLsizei -> m GLsizei) -> IO GLsizei -> m GLsizei
forall a b. (a -> b) -> a -> b
$ do
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (ByteString -> String
B8.unpack ByteString
src) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ptr ->
CString -> (Ptr CString -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CString
ptr ((Ptr CString -> IO ()) -> IO ())
-> (Ptr CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CString
ptrptr -> GLenum -> GLsizei -> Ptr CString -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr CString -> Ptr GLsizei -> m ()
glShaderSource GLenum
shader GLsizei
1 Ptr CString
ptrptr Ptr GLsizei
forall a. Ptr a
nullPtr
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCompileShader GLenum
shader
GLsizei -> (Ptr GLsizei -> IO GLsizei) -> IO GLsizei
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (GLsizei
0 :: GLint) ((Ptr GLsizei -> IO GLsizei) -> IO GLsizei)
-> (Ptr GLsizei -> IO GLsizei) -> IO GLsizei
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
ptr -> do
GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetShaderiv GLenum
shader GLenum
forall {a}. (Eq a, Num a) => a
GL_COMPILE_STATUS Ptr GLsizei
ptr
Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
ptr
if GLsizei
success GLsizei -> GLsizei -> Bool
forall a. Eq a => a -> a -> Bool
== GLsizei
forall {a}. (Eq a, Num a) => a
GL_FALSE
then do
String
err <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
[GLchar]
infoLog <- GLsizei -> (Ptr GLsizei -> IO [GLchar]) -> IO [GLchar]
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (GLsizei
0 :: GLint) ((Ptr GLsizei -> IO [GLchar]) -> IO [GLchar])
-> (Ptr GLsizei -> IO [GLchar]) -> IO [GLchar]
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
ptr -> do
GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetShaderiv GLenum
shader GLenum
forall {a}. (Eq a, Num a) => a
GL_INFO_LOG_LENGTH Ptr GLsizei
ptr
GLsizei
logsize <- Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
ptr
Int -> (CString -> IO [GLchar]) -> IO [GLchar]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
logsize) ((CString -> IO [GLchar]) -> IO [GLchar])
-> (CString -> IO [GLchar]) -> IO [GLchar]
forall a b. (a -> b) -> a -> b
$ \CString
logptr -> do
GLenum -> GLsizei -> Ptr GLsizei -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLsizei -> CString -> m ()
glGetShaderInfoLog GLenum
shader GLsizei
logsize Ptr GLsizei
forall a. Ptr a
nullPtr CString
logptr
Int -> CString -> IO [GLchar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
logsize) CString
logptr
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"Could not compile shader:"
, ByteString -> String
B8.unpack ByteString
src
, (GLchar -> Char) -> [GLchar] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (GLchar -> Int) -> GLchar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLchar -> Int
forall a. Enum a => a -> Int
fromEnum) [GLchar]
infoLog
]
Either String GLenum -> m (Either String GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GLenum -> m (Either String GLenum))
-> Either String GLenum -> m (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ String -> Either String GLenum
forall a b. a -> Either a b
Left String
err
else Either String GLenum -> m (Either String GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GLenum -> m (Either String GLenum))
-> Either String GLenum -> m (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ GLenum -> Either String GLenum
forall a b. b -> Either a b
Right GLenum
shader
compileOGLProgram
:: MonadIO m
=> [(String, Integer)]
-> [GLuint]
-> m (Either String GLuint)
compileOGLProgram :: forall (m :: * -> *).
MonadIO m =>
[(String, Integer)] -> [GLenum] -> m (Either String GLenum)
compileOGLProgram [(String, Integer)]
attribs [GLenum]
shaders = do
(GLenum
program, GLsizei
success) <- IO (GLenum, GLsizei) -> m (GLenum, GLsizei)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GLenum, GLsizei) -> m (GLenum, GLsizei))
-> IO (GLenum, GLsizei) -> m (GLenum, GLsizei)
forall a b. (a -> b) -> a -> b
$ do
GLenum
program <- IO GLenum
forall (m :: * -> *). MonadIO m => m GLenum
glCreateProgram
[GLenum] -> (GLenum -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GLenum]
shaders (GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glAttachShader GLenum
program)
[(String, Integer)] -> ((String, Integer) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Integer)]
attribs
(((String, Integer) -> IO ()) -> IO ())
-> ((String, Integer) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name, Integer
loc) ->
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
name
((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLenum -> GLenum -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> CString -> m ()
glBindAttribLocation GLenum
program
(GLenum -> CString -> IO ()) -> GLenum -> CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
loc
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glLinkProgram GLenum
program
GLsizei
success <- GLsizei -> (Ptr GLsizei -> IO GLsizei) -> IO GLsizei
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (GLsizei
0 :: GLint) ((Ptr GLsizei -> IO GLsizei) -> IO GLsizei)
-> (Ptr GLsizei -> IO GLsizei) -> IO GLsizei
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
ptr -> do
GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetProgramiv GLenum
program GLenum
forall {a}. (Eq a, Num a) => a
GL_LINK_STATUS Ptr GLsizei
ptr
Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
ptr
(GLenum, GLsizei) -> IO (GLenum, GLsizei)
forall (m :: * -> *) a. Monad m => a -> m a
return (GLenum
program, GLsizei
success)
if GLsizei
success GLsizei -> GLsizei -> Bool
forall a. Eq a => a -> a -> Bool
== GLsizei
forall {a}. (Eq a, Num a) => a
GL_FALSE
then IO (Either String GLenum) -> m (Either String GLenum)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String GLenum) -> m (Either String GLenum))
-> IO (Either String GLenum) -> m (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ GLsizei
-> (Ptr GLsizei -> IO (Either String GLenum))
-> IO (Either String GLenum)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (GLsizei
0 :: GLint) ((Ptr GLsizei -> IO (Either String GLenum))
-> IO (Either String GLenum))
-> (Ptr GLsizei -> IO (Either String GLenum))
-> IO (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
ptr -> do
GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetProgramiv GLenum
program GLenum
forall {a}. (Eq a, Num a) => a
GL_INFO_LOG_LENGTH Ptr GLsizei
ptr
GLsizei
logsize <- Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
ptr
[GLchar]
infoLog <- Int -> (CString -> IO [GLchar]) -> IO [GLchar]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
logsize) ((CString -> IO [GLchar]) -> IO [GLchar])
-> (CString -> IO [GLchar]) -> IO [GLchar]
forall a b. (a -> b) -> a -> b
$ \CString
logptr -> do
GLenum -> GLsizei -> Ptr GLsizei -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLsizei -> CString -> m ()
glGetProgramInfoLog GLenum
program GLsizei
logsize Ptr GLsizei
forall a. Ptr a
nullPtr CString
logptr
Int -> CString -> IO [GLchar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
logsize) CString
logptr
Either String GLenum -> IO (Either String GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either String GLenum -> IO (Either String GLenum))
-> Either String GLenum -> IO (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ String -> Either String GLenum
forall a b. a -> Either a b
Left
(String -> Either String GLenum) -> String -> Either String GLenum
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Could not link program"
, (GLchar -> Char) -> [GLchar] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (GLchar -> Int) -> GLchar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLchar -> Int
forall a. Enum a => a -> Int
fromEnum) [GLchar]
infoLog
]
else do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [GLenum] -> (GLenum -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GLenum]
shaders GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glDeleteShader
Either String GLenum -> m (Either String GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GLenum -> m (Either String GLenum))
-> Either String GLenum -> m (Either String GLenum)
forall a b. (a -> b) -> a -> b
$ GLenum -> Either String GLenum
forall a b. b -> Either a b
Right GLenum
program
getUniformLocation :: MonadIO m => GLuint -> String -> m GLint
getUniformLocation :: forall (m :: * -> *). MonadIO m => GLenum -> String -> m GLsizei
getUniformLocation GLenum
program String
ident = IO GLsizei -> m GLsizei
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO GLsizei -> m GLsizei) -> IO GLsizei -> m GLsizei
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO GLsizei) -> IO GLsizei
forall a. String -> (CString -> IO a) -> IO a
withCString String
ident
((CString -> IO GLsizei) -> IO GLsizei)
-> (CString -> IO GLsizei) -> IO GLsizei
forall a b. (a -> b) -> a -> b
$ GLenum -> CString -> IO GLsizei
forall (m :: * -> *). MonadIO m => GLenum -> CString -> m GLsizei
glGetUniformLocation GLenum
program
class UniformValue a where
updateUniform
:: MonadIO m
=> GLuint
-> GLint
-> a
-> m ()
clearUniformUpdateError :: (MonadIO m, Show a) => GLuint -> GLint -> a -> m ()
clearUniformUpdateError :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
prog GLsizei
loc a
val = m GLenum
forall (m :: * -> *). MonadIO m => m GLenum
glGetError m GLenum -> (GLenum -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
GLenum
0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GLenum
e -> do
let buf :: String
buf = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
256 Char
' '
String
ident <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
buf
((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
strptr -> GLsizei -> (Ptr GLsizei -> IO String) -> IO String
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLsizei
0
((Ptr GLsizei -> IO String) -> IO String)
-> (Ptr GLsizei -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
szptr -> do
GLenum -> GLenum -> GLsizei -> Ptr GLsizei -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLsizei -> Ptr GLsizei -> CString -> m ()
glGetActiveUniformName GLenum
prog (GLsizei -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
loc) GLsizei
256 Ptr GLsizei
szptr CString
strptr
GLsizei
sz <- Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
szptr
CStringLen -> IO String
peekCAStringLen (CString
strptr, GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
sz)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Could not update uniform"
, String
ident
, String
"with value"
, a -> String
forall a. Show a => a -> String
show a
val
, String
", encountered error (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
, (Integer, String) -> String
forall a. Show a => a -> String
show (Integer
forall {a}. (Eq a, Num a) => a
GL_INVALID_OPERATION :: Integer, String
"invalid operation" :: String)
, (Integer, String) -> String
forall a. Show a => a -> String
show (Integer
forall {a}. (Eq a, Num a) => a
GL_INVALID_VALUE :: Integer, String
"invalid value" :: String)
]
Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance UniformValue Bool where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Bool -> m ()
updateUniform GLenum
p GLsizei
loc Bool
bool = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GLsizei -> GLsizei -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> GLsizei -> m ()
glUniform1i GLsizei
loc (GLsizei -> IO ()) -> GLsizei -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
bool then GLsizei
1 else GLsizei
0
GLenum -> GLsizei -> Bool -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc Bool
bool
instance UniformValue Int where
updateUniform :: forall (m :: * -> *). MonadIO m => GLenum -> GLsizei -> Int -> m ()
updateUniform GLenum
p GLsizei
loc Int
enum = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GLsizei -> GLsizei -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> GLsizei -> m ()
glUniform1i GLsizei
loc (GLsizei -> IO ()) -> GLsizei -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizei) -> Int -> GLsizei
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
enum
GLenum -> GLsizei -> Int -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc Int
enum
instance UniformValue Float where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Float -> m ()
updateUniform GLenum
p GLsizei
loc Float
float = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GLsizei -> Float -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Float -> m ()
glUniform1f GLsizei
loc (Float -> IO ()) -> Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
float
GLenum -> GLsizei -> Float -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc Float
float
instance UniformValue Double where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Double -> m ()
updateUniform GLenum
p GLsizei
loc Double
d = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GLsizei -> Float -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Float -> m ()
glUniform1f GLsizei
loc (Float -> IO ()) -> Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
GLenum -> GLsizei -> Double -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc Double
d
instance UniformValue (V2 Float) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> V2 Float -> m ()
updateUniform GLenum
p GLsizei
loc V2 Float
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let V2 Float
x Float
y = (Float -> Float) -> V2 Float -> V2 Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac V2 Float
v
GLsizei -> Float -> Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Float -> Float -> m ()
glUniform2f GLsizei
loc Float
x Float
y
GLenum -> GLsizei -> V2 Float -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc V2 Float
v
instance UniformValue (V3 Float) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> V3 Float -> m ()
updateUniform GLenum
p GLsizei
loc V3 Float
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let V3 Float
x Float
y Float
z = (Float -> Float) -> V3 Float -> V3 Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac V3 Float
v
GLsizei -> Float -> Float -> Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Float -> Float -> Float -> m ()
glUniform3f GLsizei
loc Float
x Float
y Float
z
GLenum -> GLsizei -> V3 Float -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc V3 Float
v
instance UniformValue (V4 Float) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> V4 Float -> m ()
updateUniform GLenum
p GLsizei
loc V4 Float
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let (V4 Float
r Float
g Float
b Float
a) = Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> Float) -> V4 Float -> V4 Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 Float
v
GLsizei -> Float -> Float -> Float -> Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Float -> Float -> Float -> Float -> m ()
glUniform4f GLsizei
loc Float
r Float
g Float
b Float
a
GLenum -> GLsizei -> V4 Float -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc V4 Float
v
instance UniformValue (M44 Float) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> M44 Float -> m ()
updateUniform GLenum
p GLsizei
loc M44 Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
M44 Float -> (Ptr (M44 Float) -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with M44 Float
val ((Ptr (M44 Float) -> IO ()) -> IO ())
-> (Ptr (M44 Float) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLsizei -> GLsizei -> GLboolean -> Ptr Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> GLsizei -> GLboolean -> Ptr Float -> m ()
glUniformMatrix4fv GLsizei
loc GLsizei
1 GLboolean
forall {a}. (Eq a, Num a) => a
GL_TRUE (Ptr Float -> IO ())
-> (Ptr (M44 Float) -> Ptr Float) -> Ptr (M44 Float) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (M44 Float) -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr
GLenum -> GLsizei -> M44 Float -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc M44 Float
val
instance UniformValue (V2 Int) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> V2 Int -> m ()
updateUniform GLenum
p GLsizei
loc V2 Int
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let V2 GLsizei
x GLsizei
y = (Int -> GLsizei) -> V2 Int -> V2 GLsizei
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int
v
GLsizei -> GLsizei -> GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> GLsizei -> GLsizei -> m ()
glUniform2i GLsizei
loc GLsizei
x GLsizei
y
GLenum -> GLsizei -> V2 Int -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
GLenum -> GLsizei -> a -> m ()
clearUniformUpdateError GLenum
p GLsizei
loc V2 Int
v
instance UniformValue (Int,Int) where
updateUniform :: forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> (Int, Int) -> m ()
updateUniform GLenum
p GLsizei
loc = GLenum -> GLsizei -> V2 Int -> m ()
forall a (m :: * -> *).
(UniformValue a, MonadIO m) =>
GLenum -> GLsizei -> a -> m ()
updateUniform GLenum
p GLsizei
loc (V2 Int -> m ()) -> ((Int, Int) -> V2 Int) -> (Int, Int) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> V2 Int) -> (Int, Int) -> V2 Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2
mat4Translate :: Num a => V3 a -> M44 a
mat4Translate :: forall a. Num a => V3 a -> M44 a
mat4Translate = M33 a -> V3 a -> M44 a
forall a. Num a => M33 a -> V3 a -> M44 a
mkTransformationMat M33 a
forall a (t :: * -> *).
(Num a, Traversable t, Applicative t) =>
t (t a)
identity
mat4Rotate :: (Num a, Epsilon a, Floating a) => a -> V3 a -> M44 a
mat4Rotate :: forall a. (Num a, Epsilon a, Floating a) => a -> V3 a -> M44 a
mat4Rotate a
phi V3 a
v = Quaternion a -> V3 a -> M44 a
forall a. Num a => Quaternion a -> V3 a -> M44 a
mkTransformation (V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle V3 a
v a
phi) (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
0 a
0 a
0)
mat4Scale :: Num a => V3 a -> M44 a
mat4Scale :: forall a. Num a => V3 a -> M44 a
mat4Scale (V3 a
x a
y a
z) =
V4 a -> V4 a -> V4 a -> V4 a -> V4 (V4 a)
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
0 a
0 a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
y a
0 a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
z a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
1)
mat4SkewXbyY :: Num a => a -> M44 a
mat4SkewXbyY :: forall a. Num a => a -> M44 a
mat4SkewXbyY a
a =
V4 a -> V4 a -> V4 a -> V4 a -> V4 (V4 a)
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
1 a
a a
0 a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
1 a
0 a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
1 a
0)
(a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
1)
orthoProjection
:: Integral a
=> V2 a
-> M44 Float
orthoProjection :: forall a. Integral a => V2 a -> M44 Float
orthoProjection (V2 a
ww a
wh) =
let (Float
hw,Float
hh) = (a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ww, a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
wh)
in Float -> Float -> Float -> Float -> Float -> Float -> M44 Float
forall a. Fractional a => a -> a -> a -> a -> a -> a -> M44 a
ortho Float
0 Float
hw Float
hh Float
0 Float
0 Float
1
boundingBox :: (Unbox a, Real a, Fractional a) => UV.Vector (V2 a) -> (V2 a, V2 a)
boundingBox :: forall a.
(Unbox a, Real a, Fractional a) =>
Vector (V2 a) -> (V2 a, V2 a)
boundingBox Vector (V2 a)
vs
| Vector (V2 a) -> Bool
forall a. Unbox a => Vector a -> Bool
UV.null Vector (V2 a)
vs = (V2 a
0,V2 a
0)
| Bool
otherwise = ((V2 a, V2 a) -> V2 a -> (V2 a, V2 a))
-> (V2 a, V2 a) -> Vector (V2 a) -> (V2 a, V2 a)
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
UV.foldl' (V2 a, V2 a) -> V2 a -> (V2 a, V2 a)
forall {f :: * -> *} {a} {b} {b}.
(Applicative f, Real a, Fractional b, Fractional b, Ord b,
Ord b) =>
(f b, f b) -> f a -> (f b, f b)
f (V2 a
br,V2 a
tl) Vector (V2 a)
vs
where mn :: c -> a -> c
mn c
a = c -> c -> c
forall a. Ord a => a -> a -> a
min c
a (c -> c) -> (a -> c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
forall a b. (Real a, Fractional b) => a -> b
realToFrac
mx :: c -> a -> c
mx c
a = c -> c -> c
forall a. Ord a => a -> a -> a
max c
a (c -> c) -> (a -> c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
forall a b. (Real a, Fractional b) => a -> b
realToFrac
f :: (f b, f b) -> f a -> (f b, f b)
f (f b
a, f b
b) f a
c = (b -> a -> b
forall {a} {c}. (Real a, Fractional c, Ord c) => c -> a -> c
mn (b -> a -> b) -> f b -> f (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
a f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
c, b -> a -> b
forall {a} {c}. (Real a, Fractional c, Ord c) => c -> a -> c
mx (b -> a -> b) -> f b -> f (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
c)
inf :: a
inf = a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0
ninf :: a
ninf = (-a
1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0
tl :: V2 a
tl = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
ninf a
ninf
br :: V2 a
br = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
inf a
inf