3d coordinate draw.

2 files changed, 41 insertions, 10 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 0b3cd05..8f38863 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -122,6 +122,17 @@ viewProjection c
     pos = camTarget c - scale (camDistance c) (camDirection c)
     proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c)
 
+realToFracMatrix :: (Real a, Fractional t, Element t, Element a) => Matrix a -> Matrix t
+realToFracMatrix m = fromLists $ map realToFrac <$> toLists m
+
+invFloat :: Matrix Float -> Matrix Float
+invFloat m = realToFracMatrix $ inv (realToFracMatrix m :: Matrix Double)
+
+projectionView :: Camera -> (Camera,Matrix Float)
+projectionView c
+    | Just m <- camScreenToWorld c = (c,m)
+    | Just w <- camWorldToScreen c = projectionView c{ camScreenToWorld = Just $ invFloat w }
+    | otherwise                    = projectionView $ fst $ viewProjection c
 
 addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object]
 addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
@@ -446,10 +457,17 @@ onEvent w realized ev = do
                         mev <- get ev #motion
                         h <- get mev #x
                         k <- get mev #y
+                        -- let d = camPos cam + computeDirection cam h k
+                        pv <- atomicModifyIORef' (stCamera st) projectionView
                         cam <- readIORef (stCamera st)
-                        let d = camPos cam + computeDirection cam h k
-                        -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
-                        pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2)
+                        let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1
+                                          , 1 - 2 * realToFrac k/camHeight cam
+                                          , 1
+                                          , 1
+                                          ] :: Vector Float
+                            d1 = pv #> d0
+                            d = scale (1 /(d1!3) ) d1
+                        pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
                         Just win <- getWidgetWindow w
                         windowInvalidateRect win Nothing False
                         put (etype,(h,k),d)
@@ -468,10 +486,16 @@ onEvent w realized ev = do
                     bev <- get ev #button
                     h <- get bev #x
                     k <- get bev #y
+                    pv <- atomicModifyIORef' (stCamera st) projectionView
                     cam <- readIORef (stCamera st)
-                    let d = camPos cam + computeDirection cam h k
-                    -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
-                    pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2)
+                    let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1
+                                      , 1 - 2 * realToFrac k/camHeight cam
+                                      , 1
+                                      , 1
+                                      ] :: Vector Float
+                        d1 = pv #> d0
+                        d = scale (1 /(d1!3) ) d1
+                    pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
                     Just win <- getWidgetWindow w
                     windowInvalidateRect win Nothing False
                     put (etype,(h,k),d)
@@ -492,9 +516,16 @@ onEvent w realized ev = do
                     bev <- get ev #button
                     h <- get bev #x
                     k <- get bev #y
+                    pv <- atomicModifyIORef' (stCamera st) projectionView
                     cam <- readIORef (stCamera st)
-                    let d = camPos cam + computeDirection cam h k
-                    pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2)
+                    let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1
+                                      , 1 - 2 * realToFrac k/camHeight cam
+                                      , 1
+                                      , 1
+                                      ] :: Vector Float
+                        d1 = pv #> d0
+                        d = scale (1 /(d1!3) ) d1
+                    pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
                     Just win <- getWidgetWindow w
                     windowInvalidateRect win Nothing False
                 _ -> do
diff --git a/hello_obj2.lc b/hello_obj2.lc
index 1181943..629bf59 100644
--- a/hello_obj2.lc
+++ b/hello_obj2.lc
@@ -46,7 +46,7 @@ makeFrame (cubemap :: TextureCube)
     & accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True))
   `overlay`
       points
-    & mapPrimitives (\((p)) -> let p' = point p -- coordmap cam $ point p
+    & mapPrimitives (\((p)) -> let p' = coordmap cam $ point p
                                 in (p', V4 1 1 0 1 :: Vec 4 Float))
 
     & renderPoints cam
@@ -58,7 +58,7 @@ renderPoints ::
       , FragmentStream 1 ((Vec 4 Float)) )
 renderPoints cam points =
       points
-    & rasterizePrimitives (PointCtx (PointSize 10.0) 1.0 LowerLeft) ((Flat))
+    & rasterizePrimitives (PointCtx (PointSize 5.0) 1.0 LowerLeft) ((Flat))
     & mapFragments (\((c)) -> ((c)))
     & accumulateWith (DepthOp Always False, ColorOp NoBlending (V4 True True True True))