diff --git a/examples/example00/Init.hs b/examples/example00/Init.hs index b79940d..cf32a8c 100644 --- a/examples/example00/Init.hs +++ b/examples/example00/Init.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Init where @@ -100,17 +100,15 @@ load = do return (V3 x y z) ) [0..2000] - let shipList = map (uncurry $ Ship shipBO (length $ loTriangles lobj)) $ - zip poss (repeat $ Quaternion 1 (V3 0 0 0)) - -- [ (V3 0 0 0, Quaternion 1 (V3 0 0 0)) - -- -- , (V3 3 0 0, Quaternion 1 (V3 0 0 0)) - -- ] + let shipList = zipWith (uncurry $ Ship shipBO (length $ loTriangles lobj)) + poss + (repeat $ Quaternion 1 (V3 0 0 0)) phys <- initPhysics po <- initPhysicsObjects poss - mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po)) + mapM_ (addRigidBody (pWorld phys)) . bodyRigidBody) (poBalls po) addRigidBody (pWorld phys) (bodyRigidBody $ poGround po) return StateData @@ -119,7 +117,7 @@ load = do , camera = Camera { cameraFocus = V3 0 0 0 , cameraRot = Euler 0 0 0 - , cameraDist = (-50) + , cameraDist = -50 } , program = p , physics = phys diff --git a/examples/example00/Main.hs b/examples/example00/Main.hs index f3df25e..8e0fc55 100644 --- a/examples/example00/Main.hs +++ b/examples/example00/Main.hs @@ -52,12 +52,12 @@ update dt = do let phys = physics sd physos = physicsObjects sd liftIO $ stepSimulation (pWorld phys) dt 10 Nothing - posrots <- mapM (\ball -> do + posrots <- mapM ((\ball -> do ms <- liftIO $ getMotionState ball - npos <- liftIO $ return . fmap realToFrac =<< getPosition ms - nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms - return (npos, nrot) - ) (map bodyRigidBody $ poBalls physos) + npos <- liftIO $ fmap (fmap realToFrac) =<< getPosition ms + nrot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms + return (npos, nrot)) + . bodyRigidBody) (poBalls physos) let nships = map (\(ship, (pos, rot)) -> ship { shipRot = rot @@ -71,14 +71,14 @@ update dt = do draw :: Affection StateData () draw = do GL.viewport $= (GL.Position 0 0, GL.Size 1600 900) - (StateData{..}) <- getAffection + StateData{..} <- getAffection GL.currentProgram $= (Just . GLU.program $ program) - mapM_ (\(Ship{..}) -> do + mapM_ (\Ship{..} -> do let view = lookAt (cameraFocus camera + - (rotVecByEulerB2A + rotVecByEulerB2A (cameraRot camera) - (V3 0 0 (-cameraDist camera)))) + (V3 0 0 (-cameraDist camera))) (cameraFocus camera) (V3 0 1 0) model = mkTransformation shipRot shipPos @@ -97,14 +97,14 @@ handle (SDL.KeyboardEvent dat) = do handleKey key handle (SDL.MouseMotionEvent dat) = do sd <- getAffection - let (V2 rx ry) = fmap fromIntegral $ SDL.mouseMotionEventRelMotion dat + let (V2 rx ry) = fromIntegral <$> SDL.mouseMotionEventRelMotion dat c = camera sd putAffection sd { camera = case SDL.mouseMotionEventState dat of [SDL.ButtonRight] -> let (V3 sx sy sz) = rotVecByEuler (cameraRot c) (V3 (rx / 10) 0 (ry / 10)) - in c {cameraFocus = cameraFocus c + V3 (sx) 0 (sy)} + in c {cameraFocus = cameraFocus c + V3 sx 0 sy} [] -> let dphi = pi / 4 / 45 / 10 (Euler yaw pitch roll) = cameraRot c @@ -161,7 +161,7 @@ handleKey code ] = do sd <- getAffection - let ship = ships sd !! 0 + let ship = head (ships sd) rot = shipRot ship dphi = pi / 2 / 45 nquat = case code of diff --git a/examples/example00/Types.hs b/examples/example00/Types.hs index 73d4798..f7c239b 100644 --- a/examples/example00/Types.hs +++ b/examples/example00/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} - module Types where import qualified Graphics.Rendering.OpenGL as GL diff --git a/src/Init.hs b/src/Init.hs index 4eaabe2..1a03e1d 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Init where @@ -106,7 +106,7 @@ load = do , camera = Camera { cameraFocus = V3 0 0 0 , cameraRot = Euler 0 0 0 - , cameraDist = (-10) + , cameraDist = -10 } , program = p , physics = phys diff --git a/src/Main.hs b/src/Main.hs index b0846f9..de74689 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -54,8 +54,8 @@ update dt = do liftIO $ stepSimulation (pWorld phys) dt 10 Nothing (pos, rot) <- do ms <- liftIO $ getMotionState (bodyRigidBody $ poBall physos) - npos <- liftIO $ return . fmap realToFrac =<< getPosition ms - nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms + npos <- liftIO $ fmap (fmap realToFrac) =<< getPosition ms + nrot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms return (npos, nrot) let nship = (ship sd) @@ -69,14 +69,14 @@ update dt = do draw :: Affection StateData () draw = do GL.viewport $= (GL.Position 0 0, GL.Size 1600 900) - (StateData{..}) <- getAffection + StateData{..} <- getAffection GL.currentProgram $= (Just . GLU.program $ program) - (\(Ship{..}) -> do + (\Ship{..} -> do let view = lookAt (cameraFocus camera + - (rotVecByEulerB2A + rotVecByEulerB2A (cameraRot camera) - (V3 0 0 (-cameraDist camera)))) + (V3 0 0 (-cameraDist camera))) (cameraFocus camera) (V3 0 1 0) model = mkTransformation shipRot shipPos @@ -95,14 +95,14 @@ handle (SDL.KeyboardEvent dat) = do handleKey key handle (SDL.MouseMotionEvent dat) = do sd <- getAffection - let (V2 rx ry) = fmap fromIntegral $ SDL.mouseMotionEventRelMotion dat + let (V2 rx ry) = fromIntegral <$> SDL.mouseMotionEventRelMotion dat c = camera sd putAffection sd { camera = case SDL.mouseMotionEventState dat of [SDL.ButtonRight] -> let (V3 sx sy sz) = rotVecByEuler (cameraRot c) (V3 (rx / 10) 0 (ry / 10)) - in c {cameraFocus = cameraFocus c + V3 (sx) 0 (sy)} + in c {cameraFocus = cameraFocus c + V3 sx 0 sy} [] -> let dphi = pi / 4 / 45 / 10 (Euler yaw pitch roll) = cameraRot c @@ -159,9 +159,9 @@ handleKey code ] = do sd <- getAffection - let body = (bodyRigidBody $ poBall $ physicsObjects sd) + let body = bodyRigidBody $ poBall $ physicsObjects sd ms <- liftIO $ getMotionState body - rot <- liftIO $ return . fmap realToFrac =<< getRotation ms + rot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms let tor = 5 torqueimp = case code of SDL.KeycodeW -> rotate rot (V3 (-tor) 0 0) -- (-dphi) @@ -170,7 +170,7 @@ handleKey code SDL.KeycodeD -> rotate rot (V3 0 tor 0) -- dphi SDL.KeycodeE -> rotate rot (V3 0 0 (-tor)) -- (-dphi) SDL.KeycodeQ -> rotate rot (V3 0 0 tor) -- dphi - _ -> (V3 0 0 0) + _ -> V3 0 0 0 liftIO $ applyTorque (bodyRigidBody $ poBall $ physicsObjects sd) torqueimp diff --git a/src/Types.hs b/src/Types.hs index 0e0c658..61f5dcc 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} - module Types where import qualified Graphics.Rendering.OpenGL as GL