Write on the camDistance sphere.

1 files changed, 14 insertions, 5 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 273c3dc..099f8d4 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -122,7 +122,7 @@ viewProjection c
  where
     m' = proj <> cam
     cam = lookat pos (camTarget c) (camUp c)
-    pos = camTarget c - scale (camDistance c) (camDirection c)
+    pos = camPos c
     proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c)
 
 realToFracVector :: ( Real a
@@ -374,7 +374,11 @@ computeDirection cam h k | Just pv <- camScreenToWorld cam  =
                       , 1
                       ] :: Vector Float
         d1 = pv #> d0
-    in scale (1 /(d1!3) ) $ G.init d1
+        d2 = scale (1 /(d1!3)) $ G.init d1
+        p = camPos cam
+        d3 = d2 - p
+        d4 = scale (1/realToFrac (norm_2 d3)) d3
+    in d2
 computeDirection cam h k =
     let d̂ = camDirection cam -- forward
         û = camUp cam        -- upward
@@ -466,6 +470,7 @@ sanitizeCamera st = do
             , camScreenToWorld = Nothing
             }
 
+
 worldCoordinates :: State -> Double -> Double -> IO (Vector Float)
 worldCoordinates st h k = do
     pv <- atomicModifyIORef' (stCamera st) projectionView
@@ -476,7 +481,11 @@ worldCoordinates st h k = do
                       , 1
                       ] :: Vector Float
         d1 = pv #> d0
-    return $ scale (1 /(d1!3) ) d1
+        d2 = scale (1 /(d1!3)) $ G.init d1
+        p = camPos cam
+        d3 = d2 - p
+        d4 = scale (camDistance cam/realToFrac (norm_2 d3)) d3
+    return $ p + d4
 
 pushRing :: IsWidget w => w -> State -> Double -> Double -> IO (Vector Float)
 pushRing w st h k = do
@@ -532,9 +541,9 @@ onEvent w realized ev = do
                     bev <- get ev #button
                     h <- get bev #x
                     k <- get bev #y
-                    d <- G.init <$> worldCoordinates st h k
+                    _ {- d -} <- worldCoordinates st h k
                     cam <- readIORef (stCamera st)
-                    -- let d = computeDirection cam h k
+                    let d = computeDirection cam h k
                     writeIORef (stDragFrom st) $ Just (d,cam)
                     put (etype,(h,k),d)
                     return ()