john7rv

回転はrotate関数で行いますが
OpenGLで回転するときは
回転行列を保存しないといけません
他言語でのOpenGLAPIでは

pushMatrix() popMatrix()

で囲みますが
HaskallのOpenGLではその役目を

preservingMatrix

という関数を使います

また今回はタイマーを使いますので

addTimerCallback

でタイマー用のコールバック関数を渡しています


三角形を回転させるプログラム
rot.hs
ソース全文

import Data.IORef 
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU


data State = State { rotation :: IORef GLfloat }
timerInterval = 25

makeState :: IO State
makeState = do
   d <- newIORef (0.0)
   return $ State { rotation = d }
   
plusRotation :: State -> GLfloat -> IO ()
plusRotation state inc = do
   rotation state $~ (+ inc)
   postRedisplay Nothing


    
keyboard :: State -> KeyboardMouseCallback
keyboard state (Char c) Down _ _ = case c of
   'r'   -> plusRotation state (-0.5)
   'l'   -> plusRotation state 0.5
   '\27' -> exitWith ExitSuccess
   _     -> return ()
keyboard _ _ _ _ _ = return ()

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
    
timerProc func1 = do
    func1
    addTimerCallback timerInterval $ timerProc func1    
    
    
   
display :: State -> DisplayCallback
display state = do
   plusRotation state (-0.5)
   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 ()

   r <- get (rotation state)
   preservingMatrix $ do
     rotate r (Vector3 0 1 0)
     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
   
main :: IO ()
main = do
    (progName, args) <- getArgsAndInitialize
    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
    initialWindowSize $= Size 1024 768
    initialWindowPosition $= Position 100 100
    _ <- createWindow "Test3 Haskell GL"
    state <- makeState
    displayCallback $= display state
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just (keyboard state)
    addTimerCallback timerInterval $ timerProc (display state)
    mainLoop