----------------------------------------------------------------------------- -- -- Module : InputAssembler -- Copyright : Tobias Bexelius -- License : BSD3 -- -- Maintainer : Tobias Bexelius -- Stability : Experimental -- Portability : Portable -- -- | -- ----------------------------------------------------------------------------- module InputAssembler ( InputAssembler(), VertexInput(..), toGPUStream, toIndexedGPUStream, ) where import GPUStream import Shader import Control.Monad.State import Data.Vec ((:.)(..), Vec2, Vec3, Vec4) -- | A monad in which CPU data gets converted to vertex data. -- Use 'toVertex' in the existing instances of 'VertexInput' to operate in this monad. newtype InputAssembler a = InputAssembler {fromInputAssembler :: State [Float] a} deriving Monad -- | The context of types that can be converted into vertices in 'PrimitiveStream's. -- Create your own instances in terms of the existing ones, e.g. convert your vertex data to 'Float's, -- turn them into 'Vertex' 'Float's with 'toVertex' and then convert them to your vertex data representation. class GPU a => VertexInput a where -- | Turns an ordinary value into a vertex value in the 'InputAssembler' monad. This should not be strict on its argument. -- Its definition should also always use the same series of 'toVertex' calls to convert values of the same type. This unfortunatly -- rules out ordinary lists (but instances for fixed length lists from the Vec package are however provided). toVertex :: CPU a -> InputAssembler a instance VertexInput (Vertex Float) where toVertex a = InputAssembler $ do x <- gets length modify (a:) return $ inputVertex x instance VertexInput () where toVertex () = return () instance (VertexInput a,VertexInput b) => VertexInput (a,b) where toVertex (a, b) = do a' <- toVertex a b' <- toVertex b return (a', b') instance (VertexInput a,VertexInput b,VertexInput c) => VertexInput (a,b,c) where toVertex (a, b, c) = do a' <- toVertex a b' <- toVertex b c' <- toVertex c return (a', b', c') instance (VertexInput a,VertexInput b,VertexInput c,VertexInput d) => VertexInput (a,b,c,d) where toVertex (a, b, c, d) = do a' <- toVertex a b' <- toVertex b c' <- toVertex c d' <- toVertex d return (a', b', c', d') instance (VertexInput a, VertexInput b) => VertexInput (a:.b) where toVertex (a:.b) = do a' <- toVertex a b' <- toVertex b return $ a':.b' -- | Converts a list of values to a 'PrimitiveStream', using a specified 'Primitive' type. -- This function is lazy in the aspect that if parts of the values aren't used on the GPU, they won't -- get evaluated and transferred there either. toGPUStream :: (VertexInput a, Primitive p) => p -- ^ The primitive type. -> [CPU a] -- ^ A list of vertices, with the layout specified by the primitive type. -> PrimitiveStream p a -- ^ The resulting 'PrimitiveStream'. toGPUStream _ [] = PrimitiveStream [] toGPUStream p xs = let (a, fs) = getVertexInput xs in PrimitiveStream [((getPrimitiveMode p, VertexSetup fs), a)] -- | Converts a list of values to a 'PrimitiveStream', using a specified 'Primitive' type and an index list. -- This will use index buffer objects on the GPU, and is recommended if several primitives share vertices. -- This function is lazy in the aspect that if parts of the values aren't used on the GPU, they won't -- get evaluated and transferred there either. toIndexedGPUStream :: (VertexInput a, Primitive p) => p -- ^ The primitive type. -> [CPU a] -- ^ A list of vertices. -> [Int] -- ^A list of indexes into the vertex list, with the layout specified by the primitive type. -> PrimitiveStream p a -- ^ The resulting 'PrimitiveStream'. toIndexedGPUStream _ [] _ = PrimitiveStream [] toIndexedGPUStream p xs i = let (a, fs) = getVertexInput xs in PrimitiveStream [((getPrimitiveMode p, IndexedVertexSetup fs i), a)] -------------------------------------- -- Private -- getVertexInput :: forall a. VertexInput a => [CPU a] -> (a, [[Float]]) getVertexInput (x:xs) = let (a, s) = readInput x readInput :: CPU a -> (a, [Float]) readInput = flip runState [] . revState . fromInputAssembler . toVertex revState m = do x <- m modify reverse return x in (a, s : map (snd . readInput) xs)