nek0/hw
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

wörk

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

57
src/Init.hs
View file

@ -10,8 +10,6 @@ import qualified Graphics.GLUtil as GLU
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import System.Random (randomRIO)
import Physics.Bullet.Raw import Physics.Bullet.Raw
import Codec.Wavefront import Codec.Wavefront
@ -93,33 +91,22 @@ load = do
] ]
p <- GLU.simpleShaderProgramBS vertexShader fragmentShader 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 phys <- initPhysics
po <- initPhysicsObjects poss po <- initPhysicsObjects
mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po)) -- mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po))
addRigidBody (pWorld phys) (bodyRigidBody $ poGround po) addRigidBody (pWorld phys) (bodyRigidBody $ poBall po)
return StateData 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) , proj = perspective (pi/2) (1600 / 900) 1 (-1)
, camera = Camera , camera = Camera
{ cameraFocus = V3 0 0 0 { cameraFocus = V3 0 0 0
, cameraRot = Euler 0 0 0 , cameraRot = Euler 0 0 0
, cameraDist = (-50) , cameraDist = (-10)
} }
, program = p , program = p
, physics = phys , physics = phys
@ -140,26 +127,26 @@ initPhysics = do
disp <- newCollisionDispatcher config disp <- newCollisionDispatcher config
solver <- newSequentialImpulseConstraintSolver solver <- newSequentialImpulseConstraintSolver
world <- newDiscreteDynamicsWorld disp bp solver config 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 return $ Physics bp config disp solver world
initPhysicsObjects :: [V3 Float] -> IO PhysicsObjects initPhysicsObjects :: IO PhysicsObjects
initPhysicsObjects poss = do initPhysicsObjects = do
ground <- newStaticPlaneShape (V3 0 1 0) 1 -- ground <- newStaticPlaneShape (V3 0 1 0) 1
ball <- newSphereShape 3 ball <- newSphereShape 3
groundMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) (V3 0 (-51) 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) -- groundBody <- newRigidBody 0 groundMotionState 0.9 0.5 ground (V3 0 0 0)
balls <- mapM (\pos -> do -- balls <- mapM (\pos -> do
ballMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) ballMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0))
(fmap realToFrac pos) (V3 0 0 0)
localInertia <- calculateLocalInertia ball 1 (V3 0 0 0) localInertia <- calculateLocalInertia ball 1 (V3 0 0 0)
ballBody <- newRigidBody 1 ballMotionState 0.9 0.5 ball localInertia ballBody <- newRigidBody 1 ballMotionState 0 0 ball localInertia
return $ PhysBody ball ballMotionState ballBody setSleepingThresholds ballBody 0 0
) poss -- ) poss
return PhysicsObjects return PhysicsObjects
{ poGround = PhysBody ground groundMotionState groundBody -- { poGround = PhysBody ground groundMotionState groundBody
, poBalls = balls { poBall = PhysBody ball ballMotionState ballBody
} }

47
src/Main.hs
View file

@ -52,20 +52,18 @@ update dt = do
let phys = physics sd let phys = physics sd
physos = physicsObjects sd physos = physicsObjects sd
liftIO $ stepSimulation (pWorld phys) dt 10 Nothing liftIO $ stepSimulation (pWorld phys) dt 10 Nothing
posrots <- mapM (\ball -> do (pos, rot) <- do
ms <- liftIO $ getMotionState ball ms <- liftIO $ getMotionState (bodyRigidBody $ poBall physos)
npos <- liftIO $ return . fmap realToFrac =<< getPosition ms npos <- liftIO $ return . fmap realToFrac =<< getPosition ms
nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms
return (npos, nrot) return (npos, nrot)
) (map bodyRigidBody $ poBalls physos) let nship =
let nships = map (\(ship, (pos, rot)) -> (ship sd)
ship
{ shipRot = rot { shipRot = rot
, shipPos = pos , shipPos = pos
} }
) (zip (ships sd) posrots)
putAffection sd putAffection sd
{ ships = nships { ship = nship
} }
draw :: Affection StateData () draw :: Affection StateData ()
@ -73,7 +71,7 @@ draw = do
GL.viewport $= (GL.Position 0 0, GL.Size 1600 900) GL.viewport $= (GL.Position 0 0, GL.Size 1600 900)
(StateData{..}) <- getAffection (StateData{..}) <- getAffection
GL.currentProgram $= (Just . GLU.program $ program) GL.currentProgram $= (Just . GLU.program $ program)
mapM_ (\(Ship{..}) -> do (\(Ship{..}) -> do
let view = lookAt let view = lookAt
(cameraFocus camera + (cameraFocus camera +
(rotVecByEulerB2A (rotVecByEulerB2A
@ -86,7 +84,7 @@ draw = do
liftIO $ GLU.setUniform program "mvp" pvm liftIO $ GLU.setUniform program "mvp" pvm
GL.bindVertexArrayObject $= Just shipVao GL.bindVertexArrayObject $= Just shipVao
liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen) liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen)
) ships ) ship
handle :: SDL.EventPayload -> Affection StateData () handle :: SDL.EventPayload -> Affection StateData ()
handle (SDL.WindowClosedEvent _) = quit handle (SDL.WindowClosedEvent _) = quit
@ -161,21 +159,20 @@ handleKey code
] ]
= do = do
sd <- getAffection sd <- getAffection
let ship = ships sd !! 0 let body = (bodyRigidBody $ poBall $ physicsObjects sd)
rot = shipRot ship ms <- liftIO $ getMotionState body
dphi = pi / 2 / 45 rot <- liftIO $ return . fmap realToFrac =<< getRotation ms
nquat = case code of let tor = 5
SDL.KeycodeW -> rot * axisAngle (V3 1 0 0) (-dphi) torqueimp = case code of
SDL.KeycodeS -> rot * axisAngle (V3 1 0 0) dphi SDL.KeycodeW -> rotate rot (V3 (-tor) 0 0) -- (-dphi)
SDL.KeycodeA -> rot * axisAngle (V3 0 1 0) (-dphi) SDL.KeycodeS -> rotate rot (V3 tor 0 0) -- dphi
SDL.KeycodeD -> rot * axisAngle (V3 0 1 0) dphi SDL.KeycodeA -> rotate rot (V3 0 (-tor) 0) -- (-dphi)
SDL.KeycodeE -> rot * axisAngle (V3 0 0 1) (-dphi) SDL.KeycodeD -> rotate rot (V3 0 tor 0) -- dphi
SDL.KeycodeQ -> rot * axisAngle (V3 0 0 1) dphi SDL.KeycodeE -> rotate rot (V3 0 0 (-tor)) -- (-dphi)
_ -> rot SDL.KeycodeQ -> rotate rot (V3 0 0 tor) -- dphi
putAffection sd _ -> (V3 0 0 0)
{ ships = ship liftIO $ applyTorque
{ shipRot = nquat (bodyRigidBody $ poBall $ physicsObjects sd)
} : tail (ships sd) torqueimp
}
| otherwise = | otherwise =
return () return ()

6
src/Types.hs
View file

@ -12,7 +12,7 @@ import SpatialMath
import Physics.Bullet.Raw as Bullet import Physics.Bullet.Raw as Bullet
data StateData = StateData data StateData = StateData
{ ships :: [Ship] { ship :: Ship
, camera :: Camera , camera :: Camera
, proj :: M44 Float , proj :: M44 Float
, program :: GLU.ShaderProgram , program :: GLU.ShaderProgram
@ -42,8 +42,8 @@ data Physics = Physics
} }
data PhysicsObjects = PhysicsObjects data PhysicsObjects = PhysicsObjects
{ poGround :: PhysBody StaticPlaneShape -- { poGround :: PhysBody StaticPlaneShape
, poBalls :: [PhysBody SphereShape] { poBall :: PhysBody SphereShape
} }
data PhysBody a = PhysBody data PhysBody a = PhysBody