working on camera movement

This commit is contained in:
nek0 2017-09-11 05:08:08 +02:00
parent 7d1dcf91a6
commit 8a171ced87

View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Main where module Main where
@ -9,7 +9,6 @@ import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU import qualified Graphics.GLUtil as GLU
import qualified Graphics.GLUtil.Camera3D as GLU (projectionMatrix)
import Control.Monad (when) import Control.Monad (when)
@ -33,12 +32,12 @@ main =
{ initComponents = All { initComponents = All
, windowTitle = "hw" , windowTitle = "hw"
, windowConfig = SDL.defaultWindow , windowConfig = SDL.defaultWindow
{ windowInitialSize = SDL.V2 800 600 { windowInitialSize = SDL.V2 1600 900
, windowOpenGL = Just SDL.defaultOpenGL , windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 2 { SDL.glProfile = SDL.Core SDL.Normal 3 2
} }
} }
, initScreenMode = SDL.Windowed , initScreenMode = SDL.Fullscreen
, preLoop = return () , preLoop = return ()
, eventLoop = handle , eventLoop = handle
, updateLoop = update , updateLoop = update
@ -49,16 +48,30 @@ main =
} }
data StateData = StateData data StateData = StateData
{ ship :: (GL.VertexArrayObject, Int) { ships :: [Ship]
, camera :: Camera
, proj :: M44 Float , proj :: M44 Float
, view :: M44 Float -- , look :: V3 Float
, model :: V3 Float -- , view :: M44 Float
, program :: GLU.ShaderProgram , program :: GLU.ShaderProgram
, mrot :: Quaternion Float }
data Ship = Ship
{ shipVao :: GL.VertexArrayObject
, shipVaoLen :: Int
, shipPos :: V3 Float
, shipRot :: Quaternion Float
}
data Camera = Camera
{ cameraFocus :: V3 Float
, cameraRot :: Quaternion Float
, cameraDist :: Float
} }
load :: IO StateData load :: IO StateData
load = do load = do
_ <- SDL.setMouseLocationMode SDL.RelativeLocation
GL.depthFunc $= Just GL.Less GL.depthFunc $= Just GL.Less
eobj <- fromFile "assets/ships/jaeger/jaeger.obj" eobj <- fromFile "assets/ships/jaeger/jaeger.obj"
let obj = case eobj of let obj = case eobj of
@ -126,13 +139,20 @@ load = do
] ]
p <- GLU.simpleShaderProgramBS vertexShader fragmentShader p <- GLU.simpleShaderProgramBS vertexShader fragmentShader
let shipList = map (uncurry $ Ship shipBO (length $ loTriangles lobj))
[ (V3 (-3) 0 0, Quaternion 1 (V3 0 0 0))
, (V3 3 0 0, Quaternion 1 (V3 0 0 0))
]
return StateData return StateData
{ ship = (shipBO, length $ loTriangles lobj) { ships = shipList
, proj = GLU.projectionMatrix (pi/2) (800 / 600) 1 (-1) , proj = perspective (pi/2) (1600 / 900) 1 (-1)
, view = lookAt (V3 0 2 0) (V3 0 0 (-4)) (V3 0 1 0) , camera = Camera
, model = V3 0 0 (-5) { cameraFocus = V3 0 0 0
, cameraRot = Quaternion (-1) (V3 0 0 0)
, cameraDist = (-10)
}
, program = p , program = p
, mrot = Quaternion 1 (V3 0 0 0)
} }
loadTex :: FilePath -> IO GL.TextureObject loadTex :: FilePath -> IO GL.TextureObject
@ -147,13 +167,23 @@ update _ = return ()
draw :: Affection StateData () draw :: Affection StateData ()
draw = do draw = do
GL.viewport $= (GL.Position 0 0, GL.Size 800 600) GL.viewport $= (GL.Position 0 0, GL.Size 1600 900)
(StateData (shipbo, slen) p v m s rot) <- getAffection (StateData{..}) <- getAffection
let pvm = p !*! v !*! mkTransformation rot m GL.currentProgram $= (Just . GLU.program $ program)
liftIO $ GLU.setUniform s "mvp" pvm mapM_ (\(Ship{..}) -> do
GL.currentProgram $= (Just . GLU.program $ s) let view = lookAt
GL.bindVertexArrayObject $= Just shipbo (cameraFocus camera +
liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral slen) (L.rotate
(cameraRot camera)
(V3 0 0 (-cameraDist camera))))
(cameraFocus camera)
(V3 0 1 0)
model = mkTransformation shipRot shipPos
pvm = proj !*! view !*! model
liftIO $ GLU.setUniform program "mvp" pvm
GL.bindVertexArrayObject $= Just shipVao
liftIO $ GL.drawArrays GL.Triangles 0 (fromIntegral shipVaoLen)
) ships
handle :: SDL.EventPayload -> Affection StateData () handle :: SDL.EventPayload -> Affection StateData ()
handle (SDL.WindowClosedEvent _) = quit handle (SDL.WindowClosedEvent _) = quit
@ -163,6 +193,27 @@ handle (SDL.KeyboardEvent dat) = do
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $
handleKey key handleKey key
handle (SDL.MouseMotionEvent dat) = do
sd <- getAffection
let (V2 rx ry) = fmap fromIntegral $ SDL.mouseMotionEventRelMotion dat
c = camera sd
putAffection sd
{ camera =
case SDL.mouseMotionEventState dat of
[SDL.ButtonRight] ->
c {cameraFocus = cameraFocus c + V3 (rx / 10) 0 (ry / 10)}
[] ->
let dphi = pi / 2 / 45 / 2
in c
{ cameraRot =
cameraRot c * axisAngle
(normalize $ V3 (- ry) (- rx) 0)
dphi
}
_ ->
c
}
handle _ = return () handle _ = return ()
handleKey :: SDL.Keycode -> Affection StateData () handleKey :: SDL.Keycode -> Affection StateData ()
@ -196,7 +247,8 @@ handleKey code
] ]
= do = do
sd <- getAffection sd <- getAffection
let rot = mrot sd let ship = ships sd !! 0
rot = shipRot ship
dphi = pi / 2 / 45 dphi = pi / 2 / 45
nquat = case code of nquat = case code of
SDL.KeycodeW -> rot * axisAngle (V3 1 0 0) (-dphi) SDL.KeycodeW -> rot * axisAngle (V3 1 0 0) (-dphi)
@ -207,7 +259,9 @@ handleKey code
SDL.KeycodeQ -> rot * axisAngle (V3 0 0 1) dphi SDL.KeycodeQ -> rot * axisAngle (V3 0 0 1) dphi
_ -> rot _ -> rot
putAffection sd putAffection sd
{ mrot = nquat { ships = ship
{ shipRot = nquat
} : tail (ships sd)
} }
| otherwise = | otherwise =
return () return ()