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