This commit is contained in:
nek0 2017-09-21 10:28:42 +02:00
parent 21bd38bc0a
commit 349bb28a68
3 changed files with 47 additions and 63 deletions

View file

@ -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
}

View file

@ -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 ()

View file

@ -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