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

lint

Browse source
This commit is contained in:
nek0 2017-09-21 10:44:02 +02:00
parent 349bb28a68
commit 93d76ba784
6 changed files with 31 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
examples/example00/Init.hs
View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Init where
@ -100,17 +100,15 @@ load = do
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))
-- ]
let shipList = zipWith (uncurry $ Ship shipBO (length $ loTriangles lobj))
poss
(repeat $ Quaternion 1 (V3 0 0 0))
phys <- initPhysics
po <- initPhysicsObjects poss
mapM_ (addRigidBody (pWorld phys)) (map bodyRigidBody (poBalls po))
mapM_ (addRigidBody (pWorld phys)) . bodyRigidBody) (poBalls po)
addRigidBody (pWorld phys) (bodyRigidBody $ poGround po)
return StateData
@ -119,7 +117,7 @@ load = do
, camera = Camera
{ cameraFocus = V3 0 0 0
, cameraRot = Euler 0 0 0
, cameraDist = (-50)
, cameraDist = -50
}
, program = p
, physics = phys

24
examples/example00/Main.hs
View file

@ -52,12 +52,12 @@ update dt = do
let phys = physics sd
physos = physicsObjects sd
liftIO $ stepSimulation (pWorld phys) dt 10 Nothing
posrots <- mapM (\ball -> do
posrots <- mapM ((\ball -> do
ms <- liftIO $ getMotionState ball
npos <- liftIO $ return . fmap realToFrac =<< getPosition ms
nrot <- liftIO $ return . fmap realToFrac =<< getRotation ms
return (npos, nrot)
) (map bodyRigidBody $ poBalls physos)
npos <- liftIO $ fmap (fmap realToFrac) =<< getPosition ms
nrot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms
return (npos, nrot))
. bodyRigidBody) (poBalls physos)
let nships = map (\(ship, (pos, rot)) ->
ship
{ shipRot = rot
@ -71,14 +71,14 @@ update dt = do
draw :: Affection StateData ()
draw = do
GL.viewport $= (GL.Position 0 0, GL.Size 1600 900)
(StateData{..}) <- getAffection
StateData{..} <- getAffection
GL.currentProgram $= (Just . GLU.program $ program)
mapM_ (\(Ship{..}) -> do
mapM_ (\Ship{..} -> do
let view = lookAt
(cameraFocus camera +
(rotVecByEulerB2A
rotVecByEulerB2A
(cameraRot camera)
(V3 0 0 (-cameraDist camera))))
(V3 0 0 (-cameraDist camera)))
(cameraFocus camera)
(V3 0 1 0)
model = mkTransformation shipRot shipPos
@ -97,14 +97,14 @@ handle (SDL.KeyboardEvent dat) = do
handleKey key
handle (SDL.MouseMotionEvent dat) = do
sd <- getAffection
let (V2 rx ry) = fmap fromIntegral $ SDL.mouseMotionEventRelMotion dat
let (V2 rx ry) = fromIntegral <$> SDL.mouseMotionEventRelMotion dat
c = camera sd
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)}
in c {cameraFocus = cameraFocus c + V3 sx 0 sy}
[] ->
let dphi = pi / 4 / 45 / 10
(Euler yaw pitch roll) = cameraRot c
@ -161,7 +161,7 @@ handleKey code
]
= do
sd <- getAffection
let ship = ships sd !! 0
let ship = head (ships sd)
rot = shipRot ship
dphi = pi / 2 / 45
nquat = case code of

2
examples/example00/Types.hs
View file

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Types where
import qualified Graphics.Rendering.OpenGL as GL

4
src/Init.hs
View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Init where
@ -106,7 +106,7 @@ load = do
, camera = Camera
{ cameraFocus = V3 0 0 0
, cameraRot = Euler 0 0 0
, cameraDist = (-10)
, cameraDist = -10
}
, program = p
, physics = phys

22
src/Main.hs
View file

@ -54,8 +54,8 @@ update dt = do
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
npos <- liftIO $ fmap (fmap realToFrac) =<< getPosition ms
nrot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms
return (npos, nrot)
let nship =
(ship sd)
@ -69,14 +69,14 @@ update dt = do
draw :: Affection StateData ()
draw = do
GL.viewport $= (GL.Position 0 0, GL.Size 1600 900)
(StateData{..}) <- getAffection
StateData{..} <- getAffection
GL.currentProgram $= (Just . GLU.program $ program)
(\(Ship{..}) -> do
(\Ship{..} -> do
let view = lookAt
(cameraFocus camera +
(rotVecByEulerB2A
rotVecByEulerB2A
(cameraRot camera)
(V3 0 0 (-cameraDist camera))))
(V3 0 0 (-cameraDist camera)))
(cameraFocus camera)
(V3 0 1 0)
model = mkTransformation shipRot shipPos
@ -95,14 +95,14 @@ handle (SDL.KeyboardEvent dat) = do
handleKey key
handle (SDL.MouseMotionEvent dat) = do
sd <- getAffection
let (V2 rx ry) = fmap fromIntegral $ SDL.mouseMotionEventRelMotion dat
let (V2 rx ry) = fromIntegral <$> SDL.mouseMotionEventRelMotion dat
c = camera sd
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)}
in c {cameraFocus = cameraFocus c + V3 sx 0 sy}
[] ->
let dphi = pi / 4 / 45 / 10
(Euler yaw pitch roll) = cameraRot c
@ -159,9 +159,9 @@ handleKey code
]
= do
sd <- getAffection
let body = (bodyRigidBody $ poBall $ physicsObjects sd)
let body = bodyRigidBody $ poBall $ physicsObjects sd
ms <- liftIO $ getMotionState body
rot <- liftIO $ return . fmap realToFrac =<< getRotation ms
rot <- liftIO $ fmap (fmap realToFrac) =<< getRotation ms
let tor = 5
torqueimp = case code of
SDL.KeycodeW -> rotate rot (V3 (-tor) 0 0) -- (-dphi)
@ -170,7 +170,7 @@ handleKey code
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)
_ -> V3 0 0 0
liftIO $ applyTorque
(bodyRigidBody $ poBall $ physicsObjects sd)
torqueimp

2
src/Types.hs
View file

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Types where
import qualified Graphics.Rendering.OpenGL as GL