GPipeパッケージの紹介 @Haskell Advent Calender 2011#8

Haskell Advent Calenderも早いものでもう8日目となりました。
@cpp_akiraさんのお誘いで今回の記事を書くことになりました、@jirohclこと谷関です。

さて、今回はHaskellで適当にOpenGL使って遊びましょうと言うことでGPipeの紹介をしたいと思います。

まずGPipeの紹介ですが、このパッケージはGLSLをHaskell上でDSLとして表現したものになっています。
よってGLSL等の手続き型シェーダコードを書くことなく、全てHaskellのコードで書く事ができるので、せっかく関数型つかってるのに・・・と肩を落としている人は使ってみるといいんじゃないでしょうか。

といった所で今回のコード

import Graphics.GPipe
import Graphics.GPipe.Texture.Load
import Graphics.UI.GLUT( Window,
                         mainLoop,
                         postRedisplay,
                         idleCallback,
                         getArgsAndInitialize,
                         ($=))
import qualified Data.Vec as Vec
import Data.Vec.Nat
import Data.Vec.LinAlg.Transform3D
import Data.Monoid

cube :: PrimitiveStream Triangle (Vec3 (Vertex Float), Vec3 (Vertex Float))
cube = mconcat [pos_x, neg_x, pos_y, neg_y, pos_z, neg_z]
pos_x = toGPUStream TriangleStrip $ zip [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()] (repeat (1:.0:.0:.()))
neg_x = toGPUStream TriangleStrip $ zip [0:.0:.1:.(), 0:.1:.1:.(), 0:.0:.0:.(), 0:.1:.0:.()] (repeat ((-1):.0:.0:.()))
pos_y = toGPUStream TriangleStrip $ zip [0:.1:.1:.(), 1:.1:.1:.(), 0:.1:.0:.(), 1:.1:.0:.()] (repeat (0:.1:.0:.()))
neg_y = toGPUStream TriangleStrip $ zip [0:.0:.0:.(), 1:.0:.0:.(), 0:.0:.1:.(), 1:.0:.1:.()] (repeat (0:.(-1):.0:.()))
pos_z = toGPUStream TriangleStrip $ zip [1:.0:.1:.(), 1:.1:.1:.(), 0:.0:.1:.(), 0:.1:.1:.()] (repeat (0:.0:.1:.()))
neg_z = toGPUStream TriangleStrip $ zip [0:.0:.0:.(), 0:.1:.0:.(), 1:.0:.0:.(), 1:.1:.0:.()] (repeat (0:.0:.(-1):.()))

tex_coords = [ 0:.0:.(),0:.1:.(),1:.0:.(),1:.1:.()]
plane :: PrimitiveStream Triangle (Vec3 (Vertex Float),Vec2 (Vertex Float))
plane = toGPUStream TriangleStrip $ zip [(-5):.0:.(-5):.(),(-5):.0:.5:.(),5:.0:.(-5):.(),5:.0:.5:.()] tex_coords

-- vertex shader
cube_proc_scene :: PrimitiveStream Triangle (Vec4 (Vertex Float), Vec3 (Vertex Float))
cube_proc_scene = fmap (cube_transform) $ cube

cube_transform :: (Vec3 (Vertex Float),Vec3 (Vertex Float)) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
cube_transform (pos,norm) = (transformedPos,norm)
    where
         viewMat = (translation (0:.0:.(-10):.())) `multmm` (rotationX (pi/6)) `multmm` (rotationY (pi/4))
         projMat = perspective 1 100 (pi/3) (800.0 / 600.0)
         viewProjMat = projMat `multmm` viewMat
         transformedPos = toGPU viewProjMat `multmv` (homPoint pos :: Vec4 (Vertex Float))

plane_proc_scene :: PrimitiveStream Triangle (Vec4 (Vertex Float), Vec2 (Vertex Float))
plane_proc_scene = fmap (plane_transform) $ plane

plane_transform :: (Vec3 (Vertex Float),Vec2 (Vertex Float)) -> (Vec4 (Vertex Float),Vec2 (Vertex Float))
plane_transform (pos,texcoord) = (transformedPos,texcoord)
    where
         viewMat = (translation (0:.0:.(-10):.())) `multmm` (rotationX (pi/6)) `multmm` (rotationY (pi/4))
         projMat = perspective 1 100 (pi/3) (800.0 / 600.0)
         viewProjMat = projMat `multmm` viewMat
         transformedPos = toGPU viewProjMat `multmv` (homPoint pos :: Vec4 (Vertex Float))

-- fragment shader
cube_scene :: FragmentStream (Color RGBFormat (Fragment Float))
cube_scene = fmap (lit) $ rasterizeFront $ cube_proc_scene

lit (norm) = color
             where
               li = norm `dot` toGPU (0.2:.0.5:.0.3:.())
               color = RGB (li:.li:.li:.())

plane_scene :: Texture2D RGBFormat -> FragmentStream (Color RGBFormat (Fragment Float))
plane_scene tex = fmap (texed tex) $ rasterizeFront $ plane_proc_scene

texed tex (texcoord) = sample (Sampler Linear Wrap) tex texcoord

render_all :: Texture2D RGBFormat -> FrameBuffer RGBFormat () ()
render_all tex = draw (cube_scene) $ draw (plane_scene tex) clear
    where
      draw  = paintColor NoBlending (RGB (True:.True:.True:.()))
      clear = newFrameBufferColor (RGB (0.1:.0.3:.0.6:.()))

idle win = do  postRedisplay (Just win)

main :: IO ()
main = do
  getArgsAndInitialize  tex <- loadTexture RGB8 "hoge.png"
  newWindow "GPipe"
       (100:.100:.())
        (800:.600:.())
        (render_scene tex)
       init_win
  mainLoop

render_scene :: Texture2D RGBFormat -> Vec2 Int -> IO (FrameBuffer RGBFormat () ())
render_scene tex size = do
          return $ render_all tex 

init_win :: Window -> IO ()
init_win win = do
   idleCallback $= Just (idle win)

実行結果


細かいところですが、import GLUTで部分importをしていますが、これは何も考えないで全てimportしてしまうとGPipeとGLUTの宣言が衝突してしまうのからです。
では更に細かい部分を次々と、

cube :: PrimitiveStream Triangle (Vec3 (Vertex Float), Vec3 (Vertex Float))

この見慣れないPrimitiveStreamと言うのは、VertexBufferに送る情報です。
これはTriangleの他に、"Line"、"Point"も定義されているので用法、用量を守って正しくお使い下さい。
次に

pos_x = toGPUStream TriangleStrip $ zip [1:.0:.0:.(), 1:.1:.0:.(), 1:.0:.1:.(), 1:.1:.1:.()] (repeat (1:.0:.0:.()))

この部分で実際のデータを渡してあげます。
TriangleStripはOpenGLユーザーでおなじみの次々と三角形を補完してやるアレです。
他にもGPipeではTrianglesも定義されているので用途に応じて使い分ければ良いでしょう。

ここで作られたcubeの情報を次に

cube_transform :: (Vec3 (Vertex Float),Vec3 (Vertex Float)) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))

このtransformでVertexBufferにあるデータを実際にfragment shaderとラスタライザに渡すデータに変換しています。
ここがDSLで実現されたVertexShaderの部分です。

続いてfragment shader部、

cube_scene :: FragmentStream (Color RGBFormat (Fragment Float))
cube_scene = fmap (lit) $ rasterizeFront $ cube_proc_scene

ここでrasterizeFrontやrasterizeFrontAndBack等を使用してVertex Shader部分をラスタライズしますと伝えなくてはいけません。(めんどくさい)

lit (norm) = color
             where
               li = norm `dot` toGPU (0.2:.0.5:.0.3:.())
               color = RGB (li:.li:.li:.())

そしてこの部分で実際に表示する色を決定しています。

最後に、

render_all :: Texture2D RGBFormat -> FrameBuffer RGBFormat () ()
render_all tex = draw (cube_scene) $ draw (plane_scene tex) clear
    where
      draw  = paintColor NoBlending (RGB (True:.True:.True:.()))
      clear = newFrameBufferColor (RGB (0.1:.0.3:.0.6:.()))

newFrameBufferColorで新しくFrameBufferを作り、先ほどまでのコードをpaintColorで全てつなげば完了。画像が表示されます。まぁ簡単！

 

と、簡単にGPipeの紹介を行ったわけですが、これを見て判るとおり、あまり手間をかけずにHaskellを使ってshaderで遊べるのが魅力だと思います。

次は@kos59125さんのChart パッケージ編！