module InputAssembler (
InputAssembler(),
VertexInput(..),
toGPUStream,
toIndexedGPUStream,
) where
import GPUStream
import Shader
import Control.Monad.State
import Data.Vec ((:.)(..), Vec2, Vec3, Vec4)
newtype InputAssembler a = InputAssembler {fromInputAssembler :: State [Float] a} deriving Monad
class GPU a => VertexInput a where
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'
toGPUStream :: (VertexInput a, Primitive p)
=> p
-> [CPU a]
-> PrimitiveStream p a
toGPUStream _ [] = PrimitiveStreamNoShader [] undefined
toGPUStream p xs = let (a, fs) = getVertexInput xs
in PrimitiveStreamNoShader [(getPrimitiveMode p, VertexSetup fs)] a
toIndexedGPUStream :: (VertexInput a, Primitive p)
=> p
-> [CPU a]
-> [Int]
-> PrimitiveStream p a
toIndexedGPUStream _ [] _ = PrimitiveStreamNoShader [] undefined
toIndexedGPUStream p xs i = let (a, fs) = getVertexInput xs
in PrimitiveStreamNoShader [(getPrimitiveMode p, IndexedVertexSetup fs i)] a
getVertexInput :: forall a. VertexInput a => [CPU a] -> (a, [[Float]])
getVertexInput xs = let readInput :: CPU a -> (a, [Float])
readInput = flip runState [] . fromInputAssembler . toVertex
e = "The method toVertex of an instance of Graphics.GPipe.Stream.Primitive.VertexInput is strict in it's input. Remember that 'toVertex undefined >> a' must be equal to 'a'. Contact the GPipe author for more information."
in (fst $ readInput (error e :: CPU a), map (reverse . snd . readInput) xs)