Draw on the xz plane.

1 files changed, 22 insertions, 10 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 099f8d4..95c79af 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -164,6 +164,10 @@ mkFullscreenToggle w = do
              else windowUnfullscreen w
 
 
+xzPlaneVector :: Vector Float
+xzPlaneVector = fromList [ 0,1,0 -- unit normal
+                         , 0 ]   -- distance from origin
+
 uploadState :: IsWidget glarea => MeshData -> glarea -> GLStorage -> IO State
 uploadState obj glarea storage = do
     -- load OBJ geometry and material descriptions
@@ -471,25 +475,33 @@ sanitizeCamera st = do
             }
 
 
-worldCoordinates :: State -> Double -> Double -> IO (Vector Float)
-worldCoordinates st h k = do
+worldCoordinates :: State -> Double -> Double -> Maybe (Vector Float) -> IO (Vector Float)
+worldCoordinates st h k mplane = do
     pv <- atomicModifyIORef' (stCamera st) projectionView
     cam <- readIORef (stCamera st)
-    let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1
+    let q0 = fromList [ 2 * realToFrac h/camWidth cam - 1
                       , 1 - 2 * realToFrac k/camHeight cam
                       , 1
                       , 1
                       ] :: Vector Float
-        d1 = pv #> d0
-        d2 = scale (1 /(d1!3)) $ G.init d1
+        q1 = pv #> q0
+        q2 = scale (1 /(q1!3)) $ G.init q1
         p = camPos cam
-        d3 = d2 - p
-        d4 = scale (camDistance cam/realToFrac (norm_2 d3)) d3
-    return $ p + d4
+        d = q2 - p
+        d̂ = scale (1/realToFrac (norm_2 d)) d
+    return $ case mplane of
+        -- Write on the plane.
+        Just plane -> let n̂ = G.init plane
+                          c = plane!3
+                          a = (c - dot p n̂) / dot d̂ n̂
+                       in p + scale a d̂
+
+        -- Write on the camDistance sphere.
+        Nothing    -> p + scale (camDistance cam) d̂
 
 pushRing :: IsWidget w => w -> State -> Double -> Double -> IO (Vector Float)
 pushRing w st h k = do
-    d <- worldCoordinates st h k
+    d <- worldCoordinates st h k (Just xzPlaneVector)
     Just win <- getWidgetWindow w
     pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
     windowInvalidateRect win Nothing False
@@ -541,7 +553,7 @@ onEvent w realized ev = do
                     bev <- get ev #button
                     h <- get bev #x
                     k <- get bev #y
-                    _ {- d -} <- worldCoordinates st h k
+                    _ {- d -} <- worldCoordinates st h k Nothing
                     cam <- readIORef (stCamera st)
                     let d = computeDirection cam h k
                     writeIORef (stDragFrom st) $ Just (d,cam)