diff --git a/src/Init.hs b/src/Init.hs index b79940d..4eaabe2 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -10,8 +10,6 @@ import qualified Graphics.GLUtil as GLU import qualified Data.ByteString as BS -import System.Random (randomRIO) - import Physics.Bullet.Raw import Codec.Wavefront @@ -93,33 +91,22 @@ load = do ] p <- GLU.simpleShaderProgramBS vertexShader fragmentShader - poss <- mapM (\_ -> do - x <- randomRIO (-50, 50) - y <- randomRIO (-50, 50) - z <- randomRIO (-50, 50) - 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)) - -- ] - phys <- initPhysics - po <- initPhysicsObjects poss + po <- initPhysicsObjects - mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po)) - addRigidBody (pWorld phys) (bodyRigidBody $ poGround po) + -- mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po)) + addRigidBody (pWorld phys) (bodyRigidBody $ poBall po) return StateData - { ships = shipList + { ship = Ship shipBO (length $ loTriangles lobj) + (V3 0 0 0) + (Quaternion 1 (V3 0 0 0)) , proj = perspective (pi/2) (1600 / 900) 1 (-1) , camera = Camera { cameraFocus = V3 0 0 0 , cameraRot = Euler 0 0 0 - , cameraDist = (-50) + , cameraDist = (-10) } , program = p , physics = phys @@ -140,26 +127,26 @@ initPhysics = do disp <- newCollisionDispatcher config solver <- newSequentialImpulseConstraintSolver world <- newDiscreteDynamicsWorld disp bp solver config - setGravity world (V3 0 (-10) 0) + setGravity world (V3 0 0 0) return $ Physics bp config disp solver world -initPhysicsObjects :: [V3 Float] -> IO PhysicsObjects -initPhysicsObjects poss = do - ground <- newStaticPlaneShape (V3 0 1 0) 1 +initPhysicsObjects :: IO PhysicsObjects +initPhysicsObjects = do + -- ground <- newStaticPlaneShape (V3 0 1 0) 1 ball <- newSphereShape 3 - groundMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) (V3 0 (-51) 0) - groundBody <- newRigidBody 0 groundMotionState 0.9 0.5 ground (V3 0 0 0) + -- groundMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) (V3 0 (-51) 0) + -- groundBody <- newRigidBody 0 groundMotionState 0.9 0.5 ground (V3 0 0 0) - balls <- mapM (\pos -> do - ballMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) - (fmap realToFrac pos) - localInertia <- calculateLocalInertia ball 1 (V3 0 0 0) - ballBody <- newRigidBody 1 ballMotionState 0.9 0.5 ball localInertia - return $ PhysBody ball ballMotionState ballBody - ) poss + -- balls <- mapM (\pos -> do + ballMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) + (V3 0 0 0) + localInertia <- calculateLocalInertia ball 1 (V3 0 0 0) + ballBody <- newRigidBody 1 ballMotionState 0 0 ball localInertia + setSleepingThresholds ballBody 0 0 + -- ) poss return PhysicsObjects - { poGround = PhysBody ground groundMotionState groundBody - , poBalls = balls + -- { poGround = PhysBody ground groundMotionState groundBody + { poBall = PhysBody ball ballMotionState ballBody } diff --git a/src/Main.hs b/src/Main.hs index f3df25e..b0846f9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -52,20 +52,18 @@ update dt = do let phys = physics sd physos = physicsObjects sd liftIO $ stepSimulation (pWorld phys) dt 10 Nothing - posrots <- mapM (\ball -> do - ms <- liftIO $ getMotionState ball + (pos, rot) <- do + ms <- liftIO $ getMotionState (bodyRigidBody $ poBall physos) npos <- liftIO $ return . fmap realToFrac =<< getPosition ms nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms return (npos, nrot) - ) (map bodyRigidBody $ poBalls physos) - let nships = map (\(ship, (pos, rot)) -> - ship + let nship = + (ship sd) { shipRot = rot , shipPos = pos } - ) (zip (ships sd) posrots) putAffection sd - { ships = nships + { ship = nship } draw :: Affection StateData () @@ -73,7 +71,7 @@ draw = do GL.viewport $= (GL.Position 0 0, GL.Size 1600 900) (StateData{..}) <- getAffection GL.currentProgram $= (Just . GLU.program $ program) - mapM_ (\(Ship{..}) -> do + (\(Ship{..}) -> do let view = lookAt (cameraFocus camera + (rotVecByEulerB2A @@ -86,7 +84,7 @@ draw = do liftIO $ GLU.setUniform program "mvp" pvm GL.bindVertexArrayObject $= Just shipVao liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen) - ) ships + ) ship handle :: SDL.EventPayload -> Affection StateData () handle (SDL.WindowClosedEvent _) = quit @@ -161,21 +159,20 @@ handleKey code ] = do sd <- getAffection - let ship = ships sd !! 0 - rot = shipRot ship - dphi = pi / 2 / 45 - nquat = case code of - SDL.KeycodeW -> rot * axisAngle (V3 1 0 0) (-dphi) - SDL.KeycodeS -> rot * axisAngle (V3 1 0 0) dphi - SDL.KeycodeA -> rot * axisAngle (V3 0 1 0) (-dphi) - SDL.KeycodeD -> rot * axisAngle (V3 0 1 0) dphi - SDL.KeycodeE -> rot * axisAngle (V3 0 0 1) (-dphi) - SDL.KeycodeQ -> rot * axisAngle (V3 0 0 1) dphi - _ -> rot - putAffection sd - { ships = ship - { shipRot = nquat - } : tail (ships sd) - } + let body = (bodyRigidBody $ poBall $ physicsObjects sd) + ms <- liftIO $ getMotionState body + rot <- liftIO $ return . fmap realToFrac =<< getRotation ms + let tor = 5 + torqueimp = case code of + SDL.KeycodeW -> rotate rot (V3 (-tor) 0 0) -- (-dphi) + SDL.KeycodeS -> rotate rot (V3 tor 0 0) -- dphi + SDL.KeycodeA -> rotate rot (V3 0 (-tor) 0) -- (-dphi) + 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) + liftIO $ applyTorque + (bodyRigidBody $ poBall $ physicsObjects sd) + torqueimp | otherwise = return () diff --git a/src/Types.hs b/src/Types.hs index 73d4798..0e0c658 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -12,7 +12,7 @@ import SpatialMath import Physics.Bullet.Raw as Bullet data StateData = StateData - { ships :: [Ship] + { ship :: Ship , camera :: Camera , proj :: M44 Float , program :: GLU.ShaderProgram @@ -42,8 +42,8 @@ data Physics = Physics } data PhysicsObjects = PhysicsObjects - { poGround :: PhysBody StaticPlaneShape - , poBalls :: [PhysBody SphereShape] + -- { poGround :: PhysBody StaticPlaneShape + { poBall :: PhysBody SphereShape } data PhysBody a = PhysBody