Personal tools

GPipe

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (Made it a stub)
(Added textures)
Line 4: Line 4:
   
 
== Example ==
 
== Example ==
This is a simple GPipe example that animates a spinning box. Besides GPipe, it uses the
+
This is a simple GPipe example that animates a textured box. Besides [http://hackage.haskell.org/package/GPipe GPipe], it uses the
[http://hackage.haskell.org/package/Vec-Transform Vec-Transform package] for the transformation matrices.
+
[http://hackage.haskell.org/package/Vec-Transform Vec-Transform package] for the transformation matrices, and the [http://hackage.haskell.org/package/GPipe-TextureLoad 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).
   
 
<haskell>
 
<haskell>
 
module Main where
 
module Main where
+
 
import Graphics.GPipe
 
import Graphics.GPipe
  +
import Graphics.GPipe.Texture.Load
 
import Data.Monoid
 
import Data.Monoid
 
import Data.IORef
 
import Data.IORef
Line 22: Line 23:
 
getArgsAndInitialize,
 
getArgsAndInitialize,
 
($=))
 
($=))
+
sidePosX = toGPUStream TriangleStrip $ map (flip (,) (1:.0:.0:.())) [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()]
+
uvCoords = [0:.0:.(), 0:.1:.(), 1:.0:.(), 1:.1:.()]
sideNegX = toGPUStream TriangleStrip $ map (flip (,) ((-1):.0:.0:.())) [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()]
+
sidePosX = toGPUStream TriangleStrip $ zip [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()] (map ((,) (1:.0:.0:.())) uvCoords)
sidePosY = toGPUStream TriangleStrip $ map (flip (,) (0:.1:.0:.())) [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()]
+
sideNegX = toGPUStream TriangleStrip $ zip [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()] (map ((,) ((-1):.0:.0:.())) uvCoords)
sideNegY = toGPUStream TriangleStrip $ map (flip (,) (0:.(-1):.0:.())) [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()]
+
sidePosY = toGPUStream TriangleStrip $ zip [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()] (map ((,) (0:.1:.0:.())) uvCoords)
sidePosZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.1:.())) [1:.0:.1:.(), 1:.1:.1:.(), 0:.0:.1:.(), 0:.1:.1:.()]
+
sideNegY = toGPUStream TriangleStrip $ zip [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()] (map ((,) (0:.(-1):.0:.())) uvCoords)
sideNegZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.(-1):.())) [0:.0:.0:.(), 0:.1:.0:.(), 1:.0:.0:.(), 1:.1:.0:.()]
+
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]
 
cube = mconcat [sidePosX, sideNegX, sidePosY, sideNegY, sidePosZ, sideNegZ]
+
 
transformedCube a = fmap (transform a) cube
 
transformedCube a = fmap (transform a) cube
transform :: Float -> (Vec3 (Vertex Float), Vec3 (Vertex Float)) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
+
transform :: Float -> (Vec3 (Vertex Float), (Vec3 (Vertex Float), Vec2 (Vertex Float))) -> (Vec4 (Vertex Float), (Vec3 (Vertex Float), Vec2 (Vertex Float)))
transform a (pos, norm) = (transformedPos, transformedNorm)
+
transform a (pos, (norm, uv)) = (transformedPos, (transformedNorm, uv))
 
where
 
where
 
modelMat = rotationVec (normalize (1:.0.5:.0.3:.())) a `multmm` translation (-0.5)
 
modelMat = rotationVec (normalize (1:.0.5:.0.3:.())) a `multmm` translation (-0.5)
Line 42: Line 43:
 
transformedPos = toGPU (viewProjMat `multmm` modelMat) `multmv` homPoint pos
 
transformedPos = toGPU (viewProjMat `multmm` modelMat) `multmv` homPoint pos
 
transformedNorm = toGPU (Vec.map (Vec.take n3) $ Vec.take n3 $ modelMat) `multmv` norm
 
transformedNorm = toGPU (Vec.map (Vec.take n3) $ Vec.take n3 $ modelMat) `multmv` norm
+
coloredFragments a = fmap (RGB . Vec.vec . dot (toGPU (0:.0:.1:.()))) $ rasterizeFront $ transformedCube a
+
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)
 
paintSolid = paintColor NoBlending (RGB $ Vec.vec True)
+
 
main = do getArgsAndInitialize
 
main = do getArgsAndInitialize
  +
texture <- loadTexture RGB8 "myPicture.jpg" :: IO (Texture2D RGBFormat )
 
angleRef <- newIORef 0.0
 
angleRef <- newIORef 0.0
 
newWindow "Spinning box" (100:.100:.()) (800:.600:.())
 
newWindow "Spinning box" (100:.100:.()) (800:.600:.())
 
(do angle <- readIORef angleRef
 
(do angle <- readIORef angleRef
 
writeIORef angleRef ((angle + 0.01) `mod'` (2*pi))
 
writeIORef angleRef ((angle + 0.01) `mod'` (2*pi))
return $ paintSolid (coloredFragments angle) (newFrameBufferColor (RGB 0))
+
return $ paintSolid (coloredFragments texture angle) (newFrameBufferColor (RGB 0))
 
)
 
)
 
(\ w -> idleCallback $= Just (postRedisplay (Just w)))
 
(\ w -> idleCallback $= Just (postRedisplay (Just w)))
 
mainLoop
 
mainLoop
 
 
 
</haskell>
 
</haskell>
   

Revision as of 19:41, 8 December 2009

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

Box.jpg