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 25:
 
     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 46:
 
         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>
  
 
[[Image:box.jpg]]
 
[[Image:box.jpg]]

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