Last active
November 27, 2015 21:52
-
-
Save ishiy1993/263f893a53a04ecda33b to your computer and use it in GitHub Desktop.
HaskellでOpenGL(GLUT)を使って複数の三次元図形を配置する。
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Graphics.UI.GLUT | |
import Data.IORef | |
display :: IORef GLdouble -> IORef GLdouble -> DisplayCallback | |
display rot1 rot2 = do | |
clear [ColorBuffer, DepthBuffer] | |
r1 <- get rot1 | |
r2 <- get rot2 | |
loadIdentity | |
rotate r1 $ Vector3 1 0 0 | |
rotate r2 $ Vector3 0 1 0 | |
preservingMatrix $ do | |
color (Color3 1 0 0 :: Color3 GLdouble) | |
renderObject Solid $ Sphere' 1 20 20 | |
preservingMatrix $ do | |
color (Color3 0 1 0 :: Color3 GLdouble) | |
translate (Vector3 (-2) 0 0 :: Vector3 GLdouble) | |
renderObject Solid $ Sphere' 1 20 20 | |
preservingMatrix $ do | |
color (Color3 0 0 1 :: Color3 GLdouble) | |
translate (Vector3 2 0 0 :: Vector3 GLdouble) | |
renderObject Solid $ Sphere' 1 20 20 | |
swapBuffers | |
resize :: Size -> IO () | |
resize s@(Size w h) = do | |
viewport $= (Position 0 0,s) | |
matrixMode $= Projection | |
loadIdentity | |
perspective 45.0 (w'/h') 1.0 100.0 | |
lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0) | |
matrixMode $= Modelview 0 | |
where | |
w' = realToFrac w | |
h' = realToFrac h | |
keyboard :: IORef GLdouble -> IORef GLdouble -> KeyboardCallback | |
keyboard rot1 rot2 c _ = do | |
case c of | |
'j' -> rot1 $~! (subtract 1) | |
'k' -> rot1 $~! (+1) | |
'h' -> rot2 $~! (subtract 1) | |
'l' -> rot2 $~! (+1) | |
'q' -> leaveMainLoop | |
_ -> return () | |
idle :: IdleCallback | |
idle = postRedisplay Nothing | |
main :: IO () | |
main = do | |
getArgsAndInitialize | |
initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer] | |
createWindow "Sample" | |
clearColor $= Color4 1 1 1 1 | |
depthFunc $= Just Less | |
rot1 <- newIORef 0 | |
rot2 <- newIORef 0 | |
displayCallback $= display rot1 rot2 | |
reshapeCallback $= Just resize | |
keyboardCallback $= Just (keyboard rot1 rot2) | |
idleCallback $= Just idle | |
mainLoop | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment