HaskellとOpenGLを使って四角形を描画しテクスチャを貼り付ける
こんな感じになります↓
結構苦労しました。誰かの役に立ってくれると嬉しいです。
参考サイト
いろいろなサンプルがある:Index of /GLUT/examples/RedBook
今回役に立ったのは Tex〜.hs
視野の設定:Lichu's_Base
テクスチャの読み込み・設定:https://github.com/fumieval/free-game/blob/master/Graphics/FreeGame/Backends/GLFW.hs
import Graphics.UI.GLUT hiding (Bitmap) import qualified Graphics.Rendering.OpenGL.GL as GL import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) ) import Data.IORef import Codec.Picture.Repa import Data.Array.Repa as R hiding (reshape) import qualified Data.Array.Repa.Repr.ForeignPtr as RF import Foreign.ForeignPtr import Data.Word import Control.Applicative import Control.Monad import Unsafe.Coerce -- テクスチャをファイルから読み込む -- 何をやっているのか未だによくわからない -- FreeGameのサンプルをちょっといじったもの loadTextureFromFile :: FilePath -> IO GL.TextureObject loadTextureFromFile path = do content <- delay <$> (flipVertically.imgData) <$> either error id <$> (readImageRGBA path) let (Z :. width :. height :. _) = R.extent content [tex] <- GL.genObjectNames 1 GL.textureBinding GL.Texture2D GL.$= Just tex GL.textureFilter Texture2D $= ((Nearest, Nothing), Nearest) fptr <- liftM RF.toForeignPtr $ R.computeP $ content withForeignPtr fptr $ GL.texImage2D Nothing GL.NoProxy 0 GL.RGBA8 (GL.TextureSize2D (gsizei width) (gsizei height)) 0 . GL.PixelData GL.RGBA GL.UnsignedInt8888 return tex gsizei :: Int -> GL.GLsizei {-# INLINE gsizei #-} gsizei x = unsafeCoerce x --タイマの間隔 timerInterval = 40 main = do --回転の角度を初期化 rot <- newIORef 0.0 arg <- newIORef 10.4 --GLUTの初期化 initialDisplayMode $= [RGBAMode, DoubleBuffered] initialWindowSize $= Size 640 480 initialize "" [] --ウィンドウを作る createWindow "DrawPictureWithOpneGL" --テクスチャを読み込む tex <- loadTextureFromFile "読み込みたい画像ファイルへのパス" texture Texture2D $= Enabled GL.blend $= GL.Enabled GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) --表示に使うコールバック関数の指定 displayCallback $= display rot arg tex --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定 reshapeCallback $= Just reshape --キーボードやマウスのコールバック keyboardMouseCallback $= Just (keyboardProc arg) --タイマを作る addTimerCallback timerInterval $ timerProc (display rot arg tex) --GLUTのメインループに入る mainLoop display rot arg texname = do --回転させる w<-readIORef arg --w <- readIORef hoge modifyIORef rot (+w) r <- readIORef rot --背景を黒にする clearColor $= Color4 0.0 0.0 0.0 0.0 clear [ColorBuffer] --単位行列を読み込む loadIdentity -- texCoord,vetexは多くの型について定義されているので -- オーバーロードに関する問題を避けるために以下の関数が必要 let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO () vertex3f = vertex :: Vertex3 GLfloat -> IO () -- 表示 -- 描写する直前に色を指定するようだ -- Color4 赤 緑 青 透明度(0で完全に透明、1で完全に不透明) currentColor $= Color4 1 1 1 1 -- テクスチャの設定 textureBinding Texture2D $= Just texname preservingMatrix $ do translate (Vector3 100 100 (0::Double)) -- rotate 度数法での角度 rotate r (Vector3 0.0 0.0 1.0 :: Vector3 GLdouble) -- 描画 renderPrimitive Quads $ do -- ここから texCoord2f (TexCoord2 0 0) vertex3f (Vertex3 (-50) (-50) 0.0) -- ここまでで一つの頂点の設定(テクスチャに関するもの、場所に関するもの) texCoord2f (TexCoord2 0 1) vertex3f (Vertex3 (-50) 50 0.0) texCoord2f (TexCoord2 1 1) vertex3f (Vertex3 50 50 0.0) texCoord2f (TexCoord2 1 0) vertex3f (Vertex3 50 (-50) 0.0) --バッファの入れ替え swapBuffers --タイマが呼ばれるたびにactを繰り返す timerProc act = do act addTimerCallback timerInterval $ timerProc act --ウィンドウのサイズが変更された時の処理 reshape (Size w h)=do viewport $= (Position 0 0, (Size w h)) --ウィンドウ全体を使う --ビューボリュームの設定- matrixMode $= Projection loadIdentity -- 視野のセッティング ortho 0.0 640.0 0.0 480.0 (-1000.0) 1000.0 -- これ大事(理由はよくわからない) matrixMode $= Modelview 0 --キー入力の処理 keyboardProc arg ch state _ _ -- Qが押されたら終了 | ch == Char 'q' = exitWith ExitSuccess -- Aが押されたら回転速度を二倍にする | ch == Char 'a' = modifyIORef arg (*(2)) -- Sが押されたら回転速度を二分の1にする | ch == Char 's' = modifyIORef arg (*(0.5)) -- それ以外なら回転の方向を変える | state == Down = modifyIORef arg (*(-1)) | otherwise = return ()