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 パッケージ編！
