module InputAssembler (
InputAssembler(),
VertexInput(..),
toGPUStream,
toIndexedGPUStream,
) where
import GPUStream
import Shader
import Data.Vec ((:.)(..), Vec2, Vec3, Vec4)
import Control.Arrow
import Control.Category (Category)
import Control.Monad.Trans.State.Lazy
newtype InputAssembler a b = InputAssembler {fromInputAssembler :: Kleisli (State [Float]) a b} deriving (Category, Arrow)
class GPU a => VertexInput a where
toVertex :: InputAssembler (CPU a) a
instance VertexInput (Vertex Float) where
toVertex = InputAssembler $ Kleisli $ \ a -> do x <- gets length
modify (a:)
return $ inputVertex x
instance VertexInput () where
toVertex = proc () -> returnA -< ()
instance (VertexInput a,VertexInput b) => VertexInput (a,b) where
toVertex = proc (a, b) -> do a' <- toVertex -< a
b' <- toVertex -< b
returnA -< (a', b')
instance (VertexInput a,VertexInput b,VertexInput c) => VertexInput (a,b,c) where
toVertex = proc (a, b, c) -> do (a', b') <- toVertex -< (a, b)
c' <- toVertex -< c
returnA -< (a', b', c')
instance (VertexInput a,VertexInput b,VertexInput c,VertexInput d) => VertexInput (a,b,c,d) where
toVertex = proc (a, b, c, d) -> do (a', b', c') <- toVertex -< (a, b, c)
d' <- toVertex -< d
returnA -< (a', b', c', d')
instance (VertexInput a, VertexInput b) => VertexInput (a:.b) where
toVertex = proc (a:.b) -> do a' <- toVertex -< a
b' <- toVertex -< b
returnA -< 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 [] . runKleisli (fromInputAssembler (toVertex :: InputAssembler (CPU a) a))
in (fst $ readInput $ head xs, map (reverse . snd . readInput) xs)