make make
This commit is contained in:
nek0
parent
467449f374
commit
d6fd053825
8 changed files with 120 additions and 46 deletions
Binary file not shown.
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
balls <- mapM (\pos -> do
|
||||
ballMotionState <- newDefaultMotionState (Quaternion 1 (V3 0 0 0))
|
||||
(V3 0 0 0)
|
||||
(fmap realToFrac pos)
|
||||
localInertia <- calculateLocalInertia ball 1 (V3 0 0 0)
|
||||
ballBody <- newRigidBody 1 ballMotionState 0 0 ball localInertia
|
||||
ballBody <- newRigidBody 0 ballMotionState 0 0 ball localInertia
|
||||
setSleepingThresholds ballBody 0 0
|
||||
-- ) poss
|
||||
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"
|
||||
|
|
|
|||
37
examples/example03/Logging.hs
Normal file
37
examples/example03/Logging.hs
Normal file
|
|
@ -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
|
||||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ data Physics = Physics
|
|||
|
||||
data PhysicsObjects = PhysicsObjects
|
||||
-- { poGround :: PhysBody StaticPlaneShape
|
||||
{ poBall :: PhysBody SphereShape
|
||||
{ poBalls :: [PhysBody SphereShape]
|
||||
}
|
||||
|
||||
data PhysBody a = PhysBody
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
22
hw.cabal
22
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue