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

make make

Browse source
This commit is contained in:
nek0 2017-11-18 11:02:55 +01:00
parent 467449f374
commit 56a92f6cb0
9 changed files with 157 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
assets/spheres/vertHandle.blend
View file

Binary file not shown.

24
assets/spheres/vertHandle.obj
View file

@ -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

37
examples/example02/Logging.hs Normal file
View 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

36
examples/example03/Init.hs
View file

@ -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
View 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

28
examples/example03/Main.hs
View file

@ -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 ()

2
examples/example03/Types.hs
View file

@ -45,7 +45,7 @@ data Physics = Physics
data PhysicsObjects = PhysicsObjects
-- { poGround :: PhysBody StaticPlaneShape
{ poBall :: PhysBody SphereShape
{ poBalls :: [PhysBody SphereShape]
}
data PhysBody a = PhysBody

9
examples/example03/Util.hs
View file

@ -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
View file

@ -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