ゲームをつくろう その5 ブロックくずし
ブロックを複数おけるようになった。
ボールもうごかせるようになった。
というわけで、当たり判定をたしてブロックくずしにしてみる。
当たり判定は最終的に線と線の当たりにおとしこむように実装した。
しかしかなり適当なので、速度が上がってくると枠の外にぬけてしまう。
が、とりあえず今回はゲームっぽいものをつくるということでよい事にしよう。
import Graphics.UI.GLUT import Graphics.Rendering.OpenGL.GLU import System import Data.IORef import Data.List hiding (intersect) timerInterval = 16 type Point = (GLdouble, GLdouble) type Vec2 = (GLdouble, GLdouble) type Line2 = (Vec2, Vec2) type ColLine = (Line2, Vec2, Vec2) -- 法線をもった線分 平面を上からみたイメージ data GameObject = Ball{pos::Point, velocity::Vec2} | -- ボール Block {center::Point, width::GLdouble, height::GLdouble} | -- 破壊可能なブロック ABlock {center::Point, width::GLdouble, height::GLdouble} | -- 破壊不可能なブロック Paddle {center::Point, width::GLdouble, height::GLdouble, velocity::Vec2} | -- 自機 Box {center::Point, width::GLdouble, height::GLdouble} -- そとの枠 intersect :: Line2 -> Line2 -> Bool intersect l1 l2 = let ((x1, y1), (x2, y2)) = l1 ((x3, y3), (x4, y4)) = l2 in if (((x1 - x2) * (y3 - y1) + (y1 - y2) * (x1 - x3)) * ((x1 - x2) * (y4 - y1) + (y1 - y2) * (x1 - x4))) <= 0 && (((x3 - x4) * (y1 - y3) + (y3 - y4) * (x3 - x1)) * ((x3 - x4) * (y2 - y3) + (y3 - y4) * (x3 - x2))) <= 0 then True else False -- 内積 dot :: Vec2 -> Vec2 -> GLdouble dot v1 v2 = let (x1, y1) = v1 (x2, y2) = v2 in (x1 * x2) + (y1 * y2) -- ベクトル同士の加算 add :: Vec2 -> Vec2 -> Vec2 add (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) -- ベクトル同士の減算 sub :: Vec2 -> Vec2 -> Vec2 sub v1 v2 = v1 `add` ((-1.0) `mul` v2) -- ベクトルのスカラー積 mul :: GLdouble -> Vec2 -> Vec2 mul s (x, y) = (s * x, s * y) intersectBallColLine :: GameObject -> ColLine -> Bool intersectBallColLine Ball{pos=bp, velocity=bv} cl = let (cll, cln, _) = cl bl = (bp, (bp `add` bv)) in (bv `dot` cln) < 0 && intersect bl cll -- 当たり判定用のラインを作る makeColLines :: GameObject -> [ColLine] makeColLines Block{center=cn, width=w, height=h} = let (cnx, cny) = cn hw = w / 2.0 hh = h / 2.0 in [(((cnx - hw, cny + hh), (cnx + hw, cny + hh)), (0.0, 1.0), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx + hw, cny - hh)), (0.0, (-1.0)), (0.0, 0.0)), (((cnx + hw, cny - hh), (cnx + hw, cny + hh)), (1.0, 0.0), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx - hw, cny + hh)), ((-1.0), 0.0), (0.0, 0.0))] makeColLines ABlock{center=cn, width=w, height=h} = let (cnx, cny) = cn hw = w / 2.0 hh = h / 2.0 in [(((cnx - hw, cny + hh), (cnx + hw, cny + hh)), (0.0, 1.0), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx + hw, cny - hh)), (0.0, (-1.0)), (0.0, 0.0)), (((cnx + hw, cny - hh), (cnx + hw, cny + hh)), (1.0, 0.0), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx - hw, cny + hh)), ((-1.0), 0.0), (0.0, 0.0))] makeColLines Paddle{center=cn, width=w, height=h, velocity=v} = let (cnx, cny) = cn hw = w / 2.0 hh = h / 2.0 in [(((cnx - hw, cny + hh), (cnx + hw, cny + hh)), (0.0, 1.0), v), (((cnx - hw, cny - hh), (cnx + hw, cny - hh)), (0.0, (-1.0)), v), (((cnx + hw, cny - hh), (cnx + hw, cny + hh)), (1.0, 0.0), v), (((cnx - hw, cny - hh), (cnx - hw, cny + hh)), ((-1.0), 0.0), v)] makeColLines Box{center=cn, width=w, height=h} = let (cnx, cny) = cn hw = w / 2.0 hh = h / 2.0 in [(((cnx - hw, cny + hh), (cnx + hw, cny + hh)), (0.0, (-1.0)), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx + hw, cny - hh)), (0.0, 1.0), (0.0, 0.0)), (((cnx + hw, cny - hh), (cnx + hw, cny + hh)), ((-1.0), 0.0), (0.0, 0.0)), (((cnx - hw, cny - hh), (cnx - hw, cny + hh)), (1.0, 0.0), (0.0, 0.0))] -- ボールとその他オブジェクトとの当たり判定 detectColLine :: GameObject -> ColLine -> GameObject detectColLine bl@Ball{pos=bp, velocity=bv} cl = if intersectBallColLine bl cl then let (cll, cln, clv) = cl vn = mul (bv `dot` cln) cln vh = bv `sub` vn nvn = mul (-1.0) vn in Ball bp ((nvn `add` vh) `add` (0.2 `mul` clv)) else bl attack :: GameObject -> [GameObject] -> [GameObject] attack ball@Ball{pos=p, velocity=vel} gs = filter (\c -> case c of Block{} -> not $ foldr (||) False (map (intersectBallColLine ball) (makeColLines c)) _ -> True ) gs detect :: GameObject -> GameObject -> GameObject detect (ball@Ball{pos=p, velocity=vel}) Ball{} = ball detect (ball@Ball{pos=p, velocity=vel}) go = foldl detectColLine ball (makeColLines go) detectBallWithBlock :: GameObject -> [GameObject] -> GameObject detectBallWithBlock Ball{pos=p, velocity=vel} [] = Ball p vel detectBallWithBlock b gs = foldl detect b gs updateBall :: GameObject -> GameObject updateBall (Ball{pos=p, velocity=vel}) = let (x, y) = p (vx, vy) = vel in Ball (x + vx, y + vy) (vx, vy) updatePaddle :: [Key] -> GameObject -> GameObject updatePaddle ks Paddle{center=pcn, width=pw, height=ph} = let (pcnx, pcny) = pcn vx = (if ((SpecialKey KeyLeft) `elem` ks) then -1 else 0) + (if ((SpecialKey KeyRight) `elem` ks) then 1 else 0) in Paddle ((pcnx + vx), pcny) pw ph (vx, 0.0) -- ゲームオブジェクトの座標更新 update :: [Key] -> [GameObject] -> [GameObject] update ks gs = let ball = head $ filter (\o -> case o of Ball{} -> True _ -> False) gs blocks = filter (\o -> case o of Ball{} -> False Paddle{} -> False _ -> True) gs paddle = head $ filter (\o -> case o of Paddle{} -> True _ -> False ) gs crntBall = ball in [updateBall $ detectBallWithBlock ball $ blocks ++ [paddle]] ++ (attack crntBall blocks) ++ [updatePaddle ks paddle] -- ゲームオブジェクトの描画 renderGameObject :: GameObject -> IO() renderGameObject (Ball{pos=p}) = do -- ボールの描画 let (x, y) = p preservingMatrix $ do translate (Vector3 x y 0 :: Vector3 GLdouble) renderObject Wireframe (Sphere' 0.5 10 10) renderGameObject (Block{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) ] renderGameObject (ABlock{center=cn, width=w, height=h}) = do -- 破壊不可能ブロックの描画 let (x, y) = cn preservingMatrix $ do translate (Vector3 x y 0 :: Vector3 GLdouble) scale w h 1.0 renderObject Solid (Cube 1.0) renderGameObject (Paddle{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) ] 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 keystate <- newIORef [] gameObjects <- newIORef ([ Ball (0.0, (-12.0)) (0.4, 0.4), Box (0.0, 0.0) 30 60, Paddle (0.0, (-13.0)) 8.0 1.0 (0.0, 0.0)] ++ [ Block (x, y) 2.0 1.0 | x <- [(-12.0), (-10.0) .. 12.0], y <- [3.0,4.0..28.0]]) initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer] initialWindowSize $= Size 640 480 getArgsAndInitialize -- 窓の生成 createWindow "Reflect Ball" -- 描画コールバックの登録 keyboardMouseCallback $= Just (keyboardProc keystate) displayCallback $= (display gameObjects keystate) -- ウィンドウサイズが変更された時に呼ぶコールバック関数の指定 reshapeCallback $= Just reshape -- タイマー関数の登録 addTimerCallback timerInterval $ timer (display gameObjects keystate) -- GLUTのメインループへ mainLoop display gameObjects keystate = do ks <- readIORef keystate modifyIORef gameObjects (update ks) -- 背景を黒で塗り潰し 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 40.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 keystate ch state _ pos | ch == Char 'q' = exitWith ExitSuccess --qが押されたら終了 | state == Down = modifyIORef keystate (nub.(++[ch])) | state == Up = modifyIORef keystate (filter (/=ch)) | otherwise = return ()
