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

24
examples/example00/Main.hs
View file

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

2
examples/example00/Types.hs
View file

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Types where module Types where
import qualified Graphics.Rendering.OpenGL as GL 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 module Init where
@ -106,7 +106,7 @@ load = do
, camera = Camera , camera = Camera
{ cameraFocus = V3 0 0 0 { cameraFocus = V3 0 0 0
, cameraRot = Euler 0 0 0 , cameraRot = Euler 0 0 0
, cameraDist = (-10) , cameraDist = -10
} }
, program = p , program = p
, physics = phys , physics = phys

22
src/Main.hs
View file

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

2
src/Types.hs
View file

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