john7rv

GLUTを使うにはGraphics.UI.GLUTが必要です

import Graphics.UI.GLUT
import System.Exit ( exitWith, ExitCode(ExitSuccess) )

mainでGLUTの設定をします

main :: IO ()
main = do
    (progName, _args) <- getArgsAndInitialize
    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
    initialWindowSize $= Size 1024 768
    initialWindowPosition $= Position 100 100
    _ <- createWindow "Test1 Haskell GL"
    displayCallback $= display
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just keyboard
    mainLoop

initialWindowSizeでウィンドウのサイズを設定し
initialWindowPositionでウインドウの左上位置を設定します
コールバック関数とはGLUTに渡して各動作をさせる関数です

    displayCallback $= display
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just keyboard

keybordでキーボード操作の処理

keyboard :: KeyboardMouseCallback
keyboard (Char 'q')            _ _ _ = exitWith ExitSuccess
keyboard _                     _ _ _ = postRedisplay Nothing

reshapeはウインドウサイズを変更したときの処理

reshape :: ReshapeCallback
reshape size@(Size width height) = do      
    viewport $= (Position 0 0, size)
    matrixMode $= Projection
    loadIdentity
    perspective 90 (fromIntegral width / fromIntegral height) 1 100
    matrixMode $= Modelview 0

displayで描画処理 を実装します

display :: DisplayCallback
display = do
   loadIdentity
   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)
   clear [ ColorBuffer, DepthBuffer ]

   let color3f = color :: Color3 GLfloat -> IO ()
       vertex3f = vertex :: Vertex3 GLfloat -> IO ()

   renderPrimitive Triangles $ do
      color3f (Color3 1 0 0)
      vertex3f (Vertex3 0 2.5 0)
      color3f (Color3 0.5 1 0)
      vertex3f (Vertex3 (-2.5) (-1) 0)
      color3f (Color3 0 0 1)
      vertex3f (Vertex3 2.5 (-1) 0)
   
   swapBuffers

renderPrimitiveは
glBegin()glEnd()のラッパー関数です

import Graphics.UI.GLUT
import System.Exit ( exitWith, ExitCode(ExitSuccess) )


main :: IO ()
main = do
    (progName, _args) <- getArgsAndInitialize
    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
    initialWindowSize $= Size 1024 768
    initialWindowPosition $= Position 100 100
    _ <- createWindow "Test1 Haskell GL"
    displayCallback $= display
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just keyboard
    mainLoop
    
keyboard :: KeyboardMouseCallback
keyboard (Char 'q')            _ _ _ = exitWith ExitSuccess
keyboard _                     _ _ _ = postRedisplay Nothing

reshape :: ReshapeCallback
reshape size@(Size width height) = do      
    viewport $= (Position 0 0, size)
    matrixMode $= Projection
    loadIdentity
    perspective 90 (fromIntegral width / fromIntegral height) 1 100
    matrixMode $= Modelview 0
   
display :: DisplayCallback
display = do
   loadIdentity
   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)
   clear [ ColorBuffer, DepthBuffer ]

   let color3f = color :: Color3 GLfloat -> IO ()
       vertex3f = vertex :: Vertex3 GLfloat -> IO ()

   renderPrimitive Triangles $ do
      color3f (Color3 1 0 0)
      vertex3f (Vertex3 0 2.5 0)
      color3f (Color3 0.5 1 0)
      vertex3f (Vertex3 (-2.5) (-1) 0)
      color3f (Color3 0 0 1)
      vertex3f (Vertex3 2.5 (-1) 0)
   
   swapBuffers