diff --git a/examples/example02/Init.hs b/examples/example02/Init.hs index aa9f157..feb8cf8 100644 --- a/examples/example02/Init.hs +++ b/examples/example02/Init.hs @@ -71,13 +71,20 @@ load = do , " f_texcoord = texcoord;" , "}" ] - fragmentShader = foldl BS.append BS.empty + fragmentShaderSmall = foldl BS.append BS.empty [ "varying vec2 f_texcoord;" , "void main(void) {" , " gl_FragColor = vec4(1.0,1.0,1.0,1.0);" , "}" ] - p <- GLU.simpleShaderProgramBS vertexShader fragmentShader + fragmentShaderBig = foldl BS.append BS.empty + [ "varying vec2 f_texcoord;" + , "void main(void) {" + , " gl_FragColor = vec4(1.0,0,0,1.0);" + , "}" + ] + p <- GLU.simpleShaderProgramBS vertexShader fragmentShaderSmall + p2 <- GLU.simpleShaderProgramBS vertexShader fragmentShaderBig poss <- mapM (\_ -> do x <- randomRIO (-50, 50) @@ -86,21 +93,33 @@ load = do return (V3 x y z) ) [0..2000] + poss2 <- mapM (\_ -> do + x <- randomRIO (-100, 100) + y <- randomRIO (-100, 100) + z <- randomRIO (-100, 100) + return (V3 x y z) + ) [0..9] + let shipList = zipWith (Ship shipBO stl) poss (repeat $ Quaternion 1 (V3 0 0 0)) planet = Ship planetBO ptl (V3 0 0 0) (Quaternion 1 (V3 0 0 0)) + otherPlanets = zipWith (Ship planetBO ptl) + poss2 + (repeat $ Quaternion 1 (V3 0 0 0)) phys <- initPhysics - po <- initPhysicsObjects poss + po <- initPhysicsObjects poss poss2 mapM_ (addRigidBody (pWorld phys) . bodyRigidBody) (poSmallBalls po) + mapM_ (addRigidBody (pWorld phys) . bodyRigidBody) (poBigBalls po) addRigidBody (pWorld phys) (bodyRigidBody $ poBigBall po) return StateData { ships = shipList , planet = planet + , oplanets = otherPlanets , proj = perspective (pi/2) (1600 / 900) 1 (-1) , camera = Camera { cameraFocus = V3 0 0 0 @@ -108,8 +127,10 @@ load = do , cameraDist = -100 } , program = p + , program2 = p2 , physics = phys , physicsObjects = po + , focusIndex = 0 } loadTex :: FilePath -> IO GL.TextureObject @@ -129,8 +150,8 @@ initPhysics = do setGravity world (V3 0 0 0) return $ Physics bp config disp solver world -initPhysicsObjects :: [V3 Float] -> IO PhysicsObjects -initPhysicsObjects poss = do +initPhysicsObjects :: [V3 Float] -> [V3 Float] -> IO PhysicsObjects +initPhysicsObjects poss poss2 = do -- ground <- newStaticPlaneShape (V3 0 1 0) 1 smallBall <- newSphereShape 1 bigBall <- newSphereShape 5 @@ -139,13 +160,30 @@ initPhysicsObjects poss = do -- groundBody <- newRigidBody 0 groundMotionState 0.9 0.5 ground (V3 0 0 0) smallBallPOs <- mapM (\pos -> do + -- fx <- randomRIO (-1000, 1000) + -- fy <- randomRIO (-1000, 1000) + -- fz <- randomRIO (-1000, 1000) smallBallMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) (fmap realToFrac pos) localInertia <- calculateLocalInertia smallBall 1 (V3 0 0 0) smallBallBody <- newRigidBody 1 smallBallMotionState 0.9 0.5 smallBall localInertia + -- applyCentralForce smallBallBody (V3 fx fy fz) return $ PhysBody smallBall smallBallMotionState smallBallBody 1 ) poss + bigBallsPOs <- mapM (\pos -> do + let m = 1000000 + fx <- randomRIO (-1000, 1000) + fy <- randomRIO (-1000, 1000) + fz <- randomRIO (-1000, 1000) + bigBallMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) + (fmap realToFrac pos) + localInertia <- calculateLocalInertia bigBall m (V3 0 0 0) + bigBallBody <- newRigidBody m bigBallMotionState 0.9 0.5 bigBall localInertia + applyCentralForce bigBallBody (V3 fx fy fz) + return $ PhysBody bigBall bigBallMotionState bigBallBody m + ) poss2 + bigBallPO <- do bigBallMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) @@ -156,4 +194,5 @@ initPhysicsObjects poss = do return PhysicsObjects { poBigBall = bigBallPO , poSmallBalls = smallBallPOs + , poBigBalls = bigBallsPOs } diff --git a/examples/example02/Main.hs b/examples/example02/Main.hs index 1e314b6..0a7dde8 100644 --- a/examples/example02/Main.hs +++ b/examples/example02/Main.hs @@ -52,20 +52,52 @@ update dt = do sd <- getAffection let phys = physics sd physos = physicsObjects sd + g = 0.0667300 + -- g = 0.0000000000667300 + mapM_ (\smallBall -> do ms1 <- liftIO $ getMotionState (bodyRigidBody smallBall) ms2 <- liftIO $ getMotionState (bodyRigidBody $ poBigBall physos) r1 <- liftIO $ return . fmap realToFrac =<< getPosition ms1 r2 <- liftIO $ return . fmap realToFrac =<< getPosition ms2 - let g = 0.0000000000667300 - m1 = bodyMass smallBall + let m1 = bodyMass smallBall -- m2 = bodyMass (poBigBall physos) - m2 = 1000000000000000 + -- m2 = 1000000000000000 + m2 = 1000000 eta_sq = 0.1 ^ 2 force = (g * m2 * m1 *^ (r2 - r1)) ^/ ((sqrt (((r2 - r1) `dot` (r2 - r1)) + eta_sq)) ^ 3) liftIO $ applyCentralForce (bodyRigidBody smallBall) force - ) (poSmallBalls physos) + ) (poSmallBalls physos ++ poBigBalls physos) + + mapM_ (\(bb1, bb2) -> do + ms1 <- liftIO $ getMotionState (bodyRigidBody bb1) + ms2 <- liftIO $ getMotionState (bodyRigidBody bb2) + r1 <- liftIO $ return . fmap realToFrac =<< getPosition ms1 + r2 <- liftIO $ return . fmap realToFrac =<< getPosition ms2 + let m1 = bodyMass bb1 + -- m2 = bodyMass (poBigBall physos) + m2 = bodyMass bb2 + eta_sq = 0.1 ^ 2 + force = (g * m2 * m1 *^ (r2 - r1)) ^/ + ((sqrt (((r2 - r1) `dot` (r2 - r1)) + eta_sq)) ^ 3) + liftIO $ applyCentralForce (bodyRigidBody bb1) force + ) ((,) <$> (poBigBalls physos) <*> (poBigBalls physos)) + + mapM_ (\(bb1, bb2) -> do + ms1 <- liftIO $ getMotionState (bodyRigidBody bb1) + ms2 <- liftIO $ getMotionState (bodyRigidBody bb2) + r1 <- liftIO $ return . fmap realToFrac =<< getPosition ms1 + r2 <- liftIO $ return . fmap realToFrac =<< getPosition ms2 + let m1 = bodyMass bb1 + -- m2 = bodyMass (poBigBall physos) + m2 = bodyMass bb2 + eta_sq = 0.1 ^ 2 + force = (g * m2 * m1 *^ (r2 - r1)) ^/ + ((sqrt (((r2 - r1) `dot` (r2 - r1)) + eta_sq)) ^ 3) + liftIO $ applyCentralForce (bodyRigidBody bb1) force + ) ((,) <$> (poSmallBalls physos) <*> (poBigBalls physos)) + liftIO $ stepSimulation (pWorld phys) dt 10 Nothing posrots <- mapM ((\ball -> do ms <- liftIO $ getMotionState ball @@ -73,35 +105,56 @@ update dt = do nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms return (npos, nrot)) . bodyRigidBody) (poSmallBalls physos) + posrots2 <- mapM ((\ball -> do + ms <- liftIO $ getMotionState ball + npos <- liftIO $ return . fmap realToFrac =<< getPosition ms + nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms + return (npos, nrot)) + . bodyRigidBody) (poBigBalls physos) let nships = map (\(ship, (pos, rot)) -> ship { shipRot = rot , shipPos = pos } ) (zip (ships sd) posrots) + nplanets = map (\(ball, (pos, rot)) -> + ball + { shipRot = rot + , shipPos = pos + } + ) (zip (oplanets sd) posrots2) putAffection sd { ships = nships + , oplanets = nplanets + , camera = (camera sd) + { cameraFocus = shipPos ((planet sd : nplanets) !! focusIndex sd) + } } draw :: Affection StateData () draw = do GL.viewport $= (GL.Position 0 0, GL.Size 1600 900) StateData{..} <- getAffection - GL.currentProgram $= (Just . GLU.program $ program) - mapM_ (\Ship{..} -> do - let view = lookAt - (cameraFocus camera + - rotVecByEulerB2A - (cameraRot camera) - (V3 0 0 (-cameraDist camera))) - (cameraFocus camera) - (V3 0 1 0) - model = mkTransformation shipRot shipPos - pvm = proj !*! view !*! model - liftIO $ GLU.setUniform program "mvp" pvm - GL.bindVertexArrayObject $= Just shipVao - liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen) - ) (planet : ships) + drawThings program (planet : ships) + drawThings program2 oplanets + where + drawThings prog ts = do + StateData{..} <- getAffection + GL.currentProgram $= (Just . GLU.program $ prog) + mapM_ (\Ship{..} -> do + let view = lookAt + (cameraFocus camera + + rotVecByEulerB2A + (cameraRot camera) + (V3 0 0 (-cameraDist camera))) + (cameraFocus camera) + (V3 0 1 0) + model = mkTransformation shipRot shipPos + pvm = proj !*! view !*! model + liftIO $ GLU.setUniform program "mvp" pvm + GL.bindVertexArrayObject $= Just shipVao + liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen) + ) ts handle :: SDL.EventPayload -> Affection StateData () handle (SDL.WindowClosedEvent _) = quit @@ -117,9 +170,9 @@ handle (SDL.MouseMotionEvent dat) = do 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} + -- [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} [] -> let dphi = pi / 4 / 45 / 10 (Euler yaw pitch roll) = cameraRot c @@ -147,6 +200,17 @@ handle _ = return () handleKey :: SDL.Keycode -> Affection StateData () handleKey code + | code == SDL.KeycodeTab = do + ud <- getAffection + let ind = focusIndex ud + ps = planet ud : oplanets ud + if ind + 1 < length ps + then putAffection ud + { focusIndex = ind + 1 + } + else putAffection ud + { focusIndex = 0 + } | code == SDL.KeycodeR = GL.clearColor $= GL.Color4 1 0 0 1 | code == SDL.KeycodeG = diff --git a/examples/example02/Types.hs b/examples/example02/Types.hs index 35c5f47..f2a281a 100644 --- a/examples/example02/Types.hs +++ b/examples/example02/Types.hs @@ -12,11 +12,14 @@ import Physics.Bullet.Raw as Bullet data StateData = StateData { ships :: [Ship] , planet :: Ship + , oplanets :: [Ship] , camera :: Camera , proj :: M44 Float , program :: GLU.ShaderProgram + , program2 :: GLU.ShaderProgram , physics :: Physics , physicsObjects :: PhysicsObjects + , focusIndex :: Int } data Ship = Ship @@ -43,6 +46,7 @@ data Physics = Physics data PhysicsObjects = PhysicsObjects { poBigBall :: PhysBody SphereShape , poSmallBalls :: [PhysBody SphereShape] + , poBigBalls :: [PhysBody SphereShape] } data PhysBody a = PhysBody