ゲームをつくろう その4 オブジェクトの移動
IORefを使って値の保存が出来ることがわかった。なので、ゲームっぽくオブジェクトを移動させてみる。
プログラム的にはライフゲームのものとくらべて特に新しいものはないなぁ。
-- 籠の中のボール import Graphics.UI.GLUT import Graphics.Rendering.OpenGL.GLU import System import Data.IORef timerInterval = 16 type Point = (GLdouble, GLdouble) type Vec2 = (GLdouble, GLdouble) data GameObject = Ball{pos::Point, velocity::Vec2} | Box {center::Point, width::GLdouble, height::GLdouble} updateBall :: GameObject -> GameObject updateBall (Ball{pos=p, velocity=vel}) = let (x, y) = p (vx, vy) = vel in Ball (x + vx, y + vy) (vx, vy) detect :: GameObject -> GameObject -> GameObject detect (Ball{pos=p, velocity=vel}) (Box{center=cn, width=w, height=h}) = let (x, y) = p (vx, vy) = vel (wx, wy) = cn nx = x + vx ny = y + vy nvx = if ((wx - (w * 0.5)) < nx) && (nx < (wx + (w * 0.5))) then vx else vx * (-1.0) nvy = if ((wy - (h * 0.5)) < ny) && (ny < (wy + (h * 0.5))) then vy else vy * (-1.0) in Ball (x, y) (nvx, nvy) detectBallWithBox :: GameObject -> [GameObject] -> GameObject detectBallWithBox Ball{pos=p, velocity=vel} [] = Ball p vel detectBallWithBox b gs = foldl detect b gs update :: [GameObject] -> [GameObject] update gs = let ball = head $ filter (\o -> case o of Ball{} -> True _ -> False) gs box = filter (\o -> case o of Box{} -> True _ -> False) gs in [updateBall $ detectBallWithBox ball box] ++ box renderGameObject :: GameObject -> IO() renderGameObject (Ball{pos=p}) = do let (x, y) = p preservingMatrix $ do translate (Vector3 x y 0 :: Vector3 GLdouble) renderObject Solid (Sphere' 0.5 10 10) renderGameObject (Box{center=cn, width=w, height=h}) = do let (x, y) = cn renderPrimitive LineStrip $ mapM_ vertex [ Vertex3 (x + w/2.0) (y + h/2.0) 0.0, Vertex3 (x + w/2.0) (y - h/2.0) 0.0, Vertex3 (x - w/2.0) (y - h/2.0) 0.0, Vertex3 (x - w/2.0) (y + h/2.0) 0.0, Vertex3 (x + w/2.0) (y + h/2.0) (0.0 :: GLdouble) ] main :: IO() main = do gameObjects <- newIORef [ Ball (0.0, 0.0) (0.2, 0.2), Box (0.0, 0.0) 30 40 ] initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer] initialWindowSize $= Size 640 480 getArgsAndInitialize -- 窓の生成 createWindow "Reflect Ball" -- 描画コールバックの登録 keyboardMouseCallback $= Just keyboardProc displayCallback $= (display gameObjects) -- ウィンドウサイズが変更された時に呼ぶコールバック関数の指定 reshapeCallback $= Just reshape -- タイマー関数の登録 addTimerCallback timerInterval $ timer (display gameObjects) -- GLUTのメインループへ mainLoop display gameObjects = do modifyIORef gameObjects update -- 背景を黒で塗り潰し clearColor $= Color4 1.0 1.0 1.0 0.0 clear [ColorBuffer, DepthBuffer] -- 単位行列の読み込み loadIdentity -- 表示 gs <- readIORef gameObjects mapM_ renderGameObject gs swapBuffers timer act = do act addTimerCallback timerInterval $ timer act reshape size@(Size w h) = do viewport $= (Position 0 0, size) matrixMode $= Projection loadIdentity -- fov アスペクト比 ニアクリップ ファークリップ perspective 80 (fromIntegral w / fromIntegral h) 0.1 200.0 -- 視点 注視点 カメラの上方向 lookAt (Vertex3 0.0 0.0 30.0) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0) matrixMode $= Modelview 0 -- ライト設定 lighting $= Enabled -- ディフューズ position (Light 0) $= Vertex4 0.0 (-100.0) 100.0 1.0 diffuse (Light 0) $= Color4 0.0 0.0 1.0 1.0 light (Light 0) $= Enabled materialDiffuse FrontAndBack $= Color4 1.0 1.0 1.0 1.0 -- これをしないとDepthバッファが有効にならない depthFunc $= Just Less keyboardProc ch state _ _ | ch == Char 'q' = exitWith ExitSuccess --qが押されたら終了 | otherwise = return ()
箱のなかでボールが反射するだけ。