Difference between revisions of "GPipe"

From HaskellWiki
Jump to navigation Jump to search
Line 1: Line 1:
 
This is the official wiki for the [http://hackage.haskell.org/package/GPipe-1.0.1 GPipe package].
 
This is the official wiki for the [http://hackage.haskell.org/package/GPipe-1.0.1 GPipe package].
   
  +
== Example ==
In short, I will add some real-world examples on how GPipe is used. Check back in a few days!
 
  +
This is a simple GPipe example that animates a spinning box. Besides GPipe, it uses the
  +
[http://hackage.haskell.org/package/Vec-Transform-1.0.0 Vec-Transform package] for the transformation matrices.
   
  +
This is a screen dump from the running application:
In the meantime, check out this [http://hpaste.org/fastcgi/hpaste.fcgi/view?id=10451#a10451 example] by Jake McArthur.
 
  +
[[Image:box.jpg]]
   
  +
I will continue adding examples to this page, so check back every once in a while. If you have any questions, feel free to [mailto:tobias_bexelius@hotmail.com mail] me.
/Tobias Bexelius
 
  +
  +
<haskell>
  +
module Main where
  +
  +
import Graphics.GPipe
  +
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,
  +
($=))
  +
  +
sidePosX = toGPUStream TriangleStrip $ map (flip (,) (1:.0:.0:.())) [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()]
  +
sideNegX = toGPUStream TriangleStrip $ map (flip (,) ((-1):.0:.0:.())) [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()]
  +
sidePosY = toGPUStream TriangleStrip $ map (flip (,) (0:.1:.0:.())) [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()]
  +
sideNegY = toGPUStream TriangleStrip $ map (flip (,) (0:.(-1):.0:.())) [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()]
  +
sidePosZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.1:.())) [1:.0:.1:.(), 1:.1:.1:.(), 0:.0:.1:.(), 0:.1:.1:.()]
  +
sideNegZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.(-1):.())) [0:.0:.0:.(), 0:.1:.0:.(), 1:.0:.0:.(), 1:.1:.0:.()]
  +
  +
cube = mconcat [sidePosX, sideNegX, sidePosY, sideNegY, sidePosZ, sideNegZ]
  +
  +
transformedCube a = fmap (transform a) cube
  +
transform :: Float -> (Vec3 (Vertex Float), Vec3 (Vertex Float)) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
  +
transform a (pos, norm) = (transformedPos, transformedNorm)
  +
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
  +
  +
coloredFragments a = fmap (RGB . Vec.vec . dot (toGPU (0:.0:.1:.()))) $ rasterizeFront $ transformedCube a
  +
  +
paintSolid = paintColor NoBlending (RGB $ Vec.vec True)
  +
  +
main = do getArgsAndInitialize
  +
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 angle) (newFrameBufferColor (RGB 0))
  +
)
  +
(\ w -> idleCallback $= Just (postRedisplay (Just w)))
  +
mainLoop
  +
  +
  +
</haskell>

Revision as of 21:16, 8 October 2009

This is the official wiki for the GPipe package.

Example

This is a simple GPipe example that animates a spinning box. Besides GPipe, it uses the Vec-Transform package for the transformation matrices.

This is a screen dump from the running application: Box.jpg

I will continue adding examples to this page, so check back every once in a while. If you have any questions, feel free to mail me.

module Main where

import Graphics.GPipe
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,
     ($=))

sidePosX = toGPUStream TriangleStrip $ map (flip (,) (1:.0:.0:.()))  [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()]
sideNegX = toGPUStream TriangleStrip $ map (flip (,) ((-1):.0:.0:.())) [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()]
sidePosY = toGPUStream TriangleStrip $ map (flip (,) (0:.1:.0:.()))  [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()]
sideNegY = toGPUStream TriangleStrip $ map (flip (,) (0:.(-1):.0:.())) [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()]
sidePosZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.1:.()))  [1:.0:.1:.(), 1:.1:.1:.(), 0:.0:.1:.(), 0:.1:.1:.()]
sideNegZ = toGPUStream TriangleStrip $ map (flip (,) (0:.0:.(-1):.())) [0:.0:.0:.(), 0:.1:.0:.(), 1:.0:.0:.(), 1:.1:.0:.()]

cube = mconcat [sidePosX, sideNegX, sidePosY, sideNegY, sidePosZ, sideNegZ]

transformedCube a = fmap (transform a) cube
transform :: Float -> (Vec3 (Vertex Float), Vec3 (Vertex Float)) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
transform a (pos, norm) = (transformedPos, transformedNorm)
    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

coloredFragments a = fmap (RGB . Vec.vec . dot (toGPU (0:.0:.1:.()))) $ rasterizeFront $ transformedCube a

paintSolid = paintColor NoBlending (RGB $ Vec.vec True)

main = do getArgsAndInitialize
          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 angle) (newFrameBufferColor (RGB 0))
                )
                (\ w -> idleCallback $= Just (postRedisplay (Just w)))
          mainLoop