GPipe
From HaskellWiki
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
