GPipe

This article is a stub. You can help by expanding it.

This is a wiki stub for the GPipe package. If you have any questions, feel free to mail me.

Example

This is a simple GPipe example that animates a textured box. Besides GPipe, it uses the Vec-Transform package for the transformation matrices, and the GPipe-TextureLoad package for loading textures from disc.

To run this example, you'll also need an image named "myPicture.jpg" in the same directory (as you see, I used a picture of some wooden planks).

module Main where
 
import Graphics.GPipe
import Graphics.GPipe.Texture.Load
import Data.Monoid
import Data.IORef
import qualified Data.Vec as Vec
import Data.Vec.Nat
import Data.Vec.LinAlg.Transform3D
import Graphics.UI.GLUT
    (mainLoop,
     postRedisplay,
     idleCallback,
     getArgsAndInitialize,
     ($=))
 
uvCoords = [0:.0:.(), 0:.1:.(), 1:.0:.(), 1:.1:.()]
sidePosX = toGPUStream TriangleStrip $ zip [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()] (map ((,) (1:.0:.0:.())) uvCoords)
sideNegX = toGPUStream TriangleStrip $ zip [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()] (map ((,) ((-1):.0:.0:.())) uvCoords)
sidePosY = toGPUStream TriangleStrip $ zip [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()] (map ((,) (0:.1:.0:.()))  uvCoords)
sideNegY = toGPUStream TriangleStrip $ zip [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()] (map ((,) (0:.(-1):.0:.())) uvCoords)
sidePosZ = toGPUStream TriangleStrip $ zip [1:.0:.1:.(), 1:.1:.1:.(), 0:.0:.1:.(), 0:.1:.1:.()] (map ((,) (0:.0:.1:.()))  uvCoords)
sideNegZ = toGPUStream TriangleStrip $ zip [0:.0:.0:.(), 0:.1:.0:.(), 1:.0:.0:.(), 1:.1:.0:.()] (map ((,) (0:.0:.(-1):.())) uvCoords)

cube = mconcat [sidePosX, sideNegX, sidePosY, sideNegY, sidePosZ, sideNegZ]
 
transformedCube a = fmap (transform a) cube
transform :: Float -> (Vec3 (Vertex Float), (Vec3 (Vertex Float), Vec2 (Vertex Float))) -> (Vec4 (Vertex Float), (Vec3 (Vertex Float), Vec2 (Vertex Float)))
transform a (pos, (norm, uv)) = (transformedPos, (transformedNorm, uv))
    where
        modelMat = rotationVec (normalize (1:.0.5:.0.3:.())) a `multmm` translation (-0.5)
        viewMat = translation (-(0:.0:.2:.())) 
        projMat = perspective 1 100 (pi/3) (4/3)
        viewProjMat = projMat `multmm` viewMat
        transformedPos = toGPU (viewProjMat `multmm` modelMat) `multmv` homPoint pos
        transformedNorm = toGPU (Vec.map (Vec.take n3) $ Vec.take n3 $ modelMat) `multmv` norm
 
enlight tex (norm, uv) = let RGB c = sample (Sampler Linear Wrap) tex uv
                         in RGB (c * Vec.vec (norm `dot` toGPU (0:.0:.1:.())))
                            
coloredFragments tex = fmap (enlight tex) . rasterizeFront . transformedCube

paintSolid = paintColor NoBlending (RGB $ Vec.vec True)
 
main = do getArgsAndInitialize
          texture <- loadTexture RGB8 "myPicture.jpg" :: IO (Texture2D RGBFormat)
          angleRef <- newIORef 0.0
          newWindow "Spinning box" (100:.100:.()) (800:.600:.())
                (do angle <- readIORef angleRef
                    writeIORef angleRef ((angle + 0.01) `mod'` (2*pi))
                    return $ paintSolid  (coloredFragments texture angle) (newFrameBufferColor (RGB 0))
                )
                (\ w -> idleCallback $= Just (postRedisplay (Just w)))
          mainLoop