wörk
This commit is contained in:
nek0
parent
21bd38bc0a
commit
349bb28a68
3 changed files with 47 additions and 63 deletions
57
src/Init.hs
57
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
|
||||
}
|
||||
|
|
|
|||
47
src/Main.hs
47
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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue