diff --git a/assets/spheres/vertHandle.blend b/assets/spheres/vertHandle.blend index 0f517db..806e473 100644 Binary files a/assets/spheres/vertHandle.blend and b/assets/spheres/vertHandle.blend differ diff --git a/assets/spheres/vertHandle.obj b/assets/spheres/vertHandle.obj index c1b2e6a..ed5b583 100644 --- a/assets/spheres/vertHandle.obj +++ b/assets/spheres/vertHandle.obj @@ -2,18 +2,18 @@ # www.blender.org mtllib vertHandle.mtl o Icosphere -v 0.000000 -0.100000 0.000000 -v 0.072360 -0.044721 0.052572 -v -0.027639 -0.044721 0.085064 -v -0.089442 -0.044721 0.000000 -v -0.027639 -0.044721 -0.085064 -v 0.072360 -0.044721 -0.052572 -v 0.027639 0.044721 0.085064 -v -0.072360 0.044721 0.052572 -v -0.072360 0.044721 -0.052572 -v 0.027639 0.044721 -0.085064 -v 0.089442 0.044721 0.000000 -v 0.000000 0.100000 0.000000 +v 0.000000 -0.050000 0.000000 +v 0.036180 -0.022361 0.026286 +v -0.013819 -0.022361 0.042532 +v -0.044721 -0.022361 0.000000 +v -0.013819 -0.022361 -0.042532 +v 0.036180 -0.022361 -0.026286 +v 0.013819 0.022361 0.042532 +v -0.036180 0.022361 0.026286 +v -0.036180 0.022361 -0.026286 +v 0.013819 0.022361 -0.042532 +v 0.044721 0.022361 0.000000 +v 0.000000 0.050000 0.000000 vn 0.1876 -0.7947 0.5774 vn 0.6071 -0.7947 0.0000 vn -0.4911 -0.7947 0.3568 diff --git a/examples/example03/Init.hs b/examples/example03/Init.hs index a99c9af..14d3418 100644 --- a/examples/example03/Init.hs +++ b/examples/example03/Init.hs @@ -23,6 +23,7 @@ import Foreign import Util import Types +import Logging as LL import Debug.Trace @@ -92,12 +93,14 @@ load = do phys <- initPhysics - po <- initPhysicsObjects + po <- initPhysicsObjects (map listToPos $ chunksOf 4 $ loLocations sobj) -- traceIO $ show $ loLines sobj -- mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po)) - addRigidBody (pWorld phys) (bodyRigidBody $ poBall po) + mapM_ (\b -> addRigidBody (pWorld phys) (bodyRigidBody b)) (poBalls po) + + logIO Debug "Hello world" return StateData { ship = (Ship svao stl @@ -105,7 +108,7 @@ load = do (Quaternion 1 (V3 0 0 0)) (Just t) (Just texture)) - , vertHandles = createHandles hvao vhtl (loTriangles sobj) + , vertHandles = createHandles hvao vhtl (loLocations sobj) , proj = perspective (pi/2) (1600 / 900) 1 (-1) , camera = Camera { cameraFocus = V3 0 0 0 @@ -128,25 +131,26 @@ initPhysics = do setGravity world (V3 0 0 0) return $ Physics bp config disp solver world -initPhysicsObjects :: IO PhysicsObjects -initPhysicsObjects = do +initPhysicsObjects :: [V3 Float] -> IO PhysicsObjects +initPhysicsObjects poss = do -- ground <- newStaticPlaneShape (V3 0 1 0) 1 - ball <- newSphereShape 3 + ball <- newSphereShape 0.05 -- 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)) - (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 + 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 0 ballMotionState 0 0 ball localInertia + setSleepingThresholds ballBody 0 0 + return $ PhysBody ball ballMotionState ballBody + ) poss return PhysicsObjects -- { poGround = PhysBody ground groundMotionState groundBody - { poBall = PhysBody ball ballMotionState ballBody + { poBalls = balls } genVertBufObject :: FilePath -> IO (GL.BufferObject, LoadedObject, Int) @@ -174,8 +178,10 @@ genVertBufObject path = do createHandles :: GL.VertexArrayObject -> Int -> [Float] -> [Ship] createHandles bo len ps = - map (\p -> Ship bo len (toPos p) (Quaternion 1 (V3 0 0 0)) Nothing Nothing) tris + map (\p -> Ship bo len (listToPos p) (Quaternion 1 (V3 0 0 0)) Nothing Nothing) tris where - tris = chunksOf 3 ps - toPos [x, y, z] = V3 x y z - toPos _ = error "not triangular" + tris = chunksOf 4 ps + +listToPos :: [Float] -> V3 Float +listToPos [x, y, z, _] = V3 x y z +listToPos _ = error "listToPos: not triangular coordinates encountered" diff --git a/examples/example03/Logging.hs b/examples/example03/Logging.hs new file mode 100644 index 0000000..2fe52db --- /dev/null +++ b/examples/example03/Logging.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE CPP #-} +module Logging where + +import Debug.Trace + +data LogLevel + = Debug + | Warn + | Error + +log :: LogLevel -> String -> a -> a +#if defined(DEBUG) +log Debug s = trace ("DEBUG: " ++ s) +#endif +#if defined(WARN) || defined(DEBUG) +log Warn s = trace ("WARN: " ++ s) +#endif +#if defined(ERROR) || defined(WARN) || defined(DEBUG) +log Error s = trace ("ERROR: " ++ s) +#endif +#if !(defined(ERROR) && defined(WARN) && defined(DEBUG)) || !defined(DEBUG) +log _ _ = id +#endif + +logIO :: LogLevel -> String -> IO () +#if defined(DEBUG) +logIO Debug s = traceIO ("DEBUG: " ++ s) +#endif +#if defined(WARN) || defined(DEBUG) +logIO Warn s = traceIO ("WARN: " ++ s) +#endif +#if defined(ERROR) || defined(WARN) || defined(DEBUG) +logIO Error s = traceIO ("ERROR: " ++ s) +#endif +#if !(defined(ERROR) && defined(WARN) && defined(DEBUG)) || !defined(DEBUG) +logIO _ _ = return () +#endif diff --git a/examples/example03/Main.hs b/examples/example03/Main.hs index 74a533d..6762b03 100644 --- a/examples/example03/Main.hs +++ b/examples/example03/Main.hs @@ -55,18 +55,26 @@ update dt = do let phys = physics sd physos = physicsObjects sd liftIO $ stepSimulation (pWorld phys) dt 10 Nothing - (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) - let nship = - (ship sd) - { shipRot = rot - , shipPos = pos - } + nvhs <- mapM (\(smallBall, vh) -> do + ms1 <- liftIO $ getMotionState (bodyRigidBody smallBall) + r1 <- liftIO $ return . fmap realToFrac =<< getPosition ms1 + return vh + { shipPos = r1 + } + ) (zip (poBalls physos) (vertHandles sd)) + -- (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) + -- let nship = + -- (ship sd) + -- { shipRot = rot + -- , shipPos = pos + -- } putAffection sd - { ship = nship + { -- ship = nship + vertHandles = nvhs } draw :: Affection StateData () diff --git a/examples/example03/Types.hs b/examples/example03/Types.hs index c167312..931ab46 100644 --- a/examples/example03/Types.hs +++ b/examples/example03/Types.hs @@ -45,7 +45,7 @@ data Physics = Physics data PhysicsObjects = PhysicsObjects -- { poGround :: PhysBody StaticPlaneShape - { poBall :: PhysBody SphereShape + { poBalls :: [PhysBody SphereShape] } data PhysBody a = PhysBody diff --git a/examples/example03/Util.hs b/examples/example03/Util.hs index 3b40c0b..15a4422 100644 --- a/examples/example03/Util.hs +++ b/examples/example03/Util.hs @@ -17,19 +17,19 @@ data LoadedObject = LoadedObject { loTriangles :: [Float] , loLines :: [Float] , loPoints :: [Float] + , loLocations :: [Float] , loTexTri :: Maybe [Float] } deriving (Show) loadObj :: WavefrontOBJ -> LoadedObject loadObj obj = - LoadedObject ts ls ps tritex + LoadedObject ts ls ps locs tritex where inter = objLocations obj interTex = objTexCoords obj faces = map elValue (V.toList $ objFaces obj) lns = map elValue (V.toList $ objLines obj) - points = trace (show $ map elValue (V.toList $ objPoints obj)) - (map elValue (V.toList $ objPoints obj)) + points = map elValue (V.toList $ objPoints obj) deface (Face a b c []) = map (\i -> inter V.! (faceLocIndex i -1)) [a, b, c] deface _ = @@ -39,12 +39,13 @@ loadObj obj = depoint (Point i) = inter V.! (i - 1) tsLocs = concatMap deface faces lsLocs = concatMap deline lns - psLocs = map depoint (trace (show points) points) + psLocs = map depoint points deLoc (Location x y z w) = [x, y, z, w] deTex (TexCoord r s _) = [r, s] ts = concatMap deLoc tsLocs ls = concatMap deLoc lsLocs ps = concatMap deLoc psLocs + locs = concatMap deLoc (V.toList inter) defaceTex :: Face -> Maybe [TexCoord] defaceTex (Face a b c []) = mapM diff --git a/hw.cabal b/hw.cabal index 4767bbf..028b71c 100644 --- a/hw.cabal +++ b/hw.cabal @@ -15,6 +15,21 @@ build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 +flag debug + description: Enable debug messages + default: False + manual: True + +flag warn + description: Enable warning messages + default: False + manual: True + +flag error + description: Enable error messages + default: False + manual: True + executable hw main-is: Main.hs other-modules: Util @@ -123,10 +138,17 @@ executable example02 extra-libraries: stdc++ executable example03 + if flag(debug) + cpp-options: -DDEBUG + if flag(warn) + cpp-options: -DWARN + if flag(error) + cpp-options: -DERROR main-is: Main.hs other-modules: Util , Types , Init + , Logging -- other-extensions: default-extensions: OverloadedStrings build-depends: base >=4.9