From 5abe70c7457ebedc5e4e348e3dc5a7b830fab897 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 2 May 2019 03:24:53 -0400 Subject: Rotate camera-up direction too. --- MeshSketch.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/MeshSketch.hs b/MeshSketch.hs index c88da0c..5bf6fea 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs @@ -170,7 +170,7 @@ whirlingCamera st = Animation $ \_ t -> do let tf = realToFrac t :: Float rot = rotMatrixZ (-tf/2) <> rotMatrixX (-tf/pi) modifyIORef (stCamera st) $ \cam -> cam - { camUp = rot #> fromList [0,1,0] + { camUp = fromList [0,1,0] <# rot , camDirection = (scale (1/camDistance cam) $ fromList [-2,-2,-10]) <# rot , camWorldToScreen = Nothing , camScreenToWorld = Nothing @@ -335,9 +335,15 @@ updateCameraRotation w st h k = do -- tu = dt `dot` û -- td = dt `dot` d̂ cosθ = dot df dt / realToFrac (norm_2 df) / realToFrac (norm_2 dt) - axis = df `cross` dt + axis0 = df `cross` dt + small x = abs x < 0.00001 + axis = let xs = toList axis0 + in if any isNaN xs || all small xs + then fromList [0,1,0] + else axis0 cam' = cam { camDirection = d̂ <# rotate cosθ axis + , camUp = û <# rotate cosθ axis , camWorldToScreen = Nothing , camScreenToWorld = Nothing } @@ -349,13 +355,20 @@ updateCameraRotation w st h k = do sanitizeCamera st = do modifyIORef (stCamera st) $ \cam -> let d = camDirection cam + u = camUp cam dd = norm_2 d + uu = norm_2 u e = scale (realToFrac $ 1/dd) d d̂ = if any isNaN (toList e) then fromList [0,0,-1] else e + f = scale (realToFrac $ 1/uu) u + û = if any isNaN (toList f) + then fromList [0,1,0] + else f in cam { camDirection = d̂ + , camUp = û , camWorldToScreen = Nothing , camScreenToWorld = Nothing } -- cgit v1.2.3