Point primitive stream based ring buffer.

1 files changed, 20 insertions, 9 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 16c8284..0b3cd05 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -48,7 +48,7 @@ import LoadMesh
 import InfinitePlane
 import MtlParser (ObjMaterial(..))
 import Matrix
-import TextureBufferRing
+import PointPrimitiveRing
 
 
 prettyDebug :: GL.DebugMessage -> String
@@ -96,6 +96,8 @@ data Camera = Camera
     , camScreenToWorld :: Maybe (Matrix Float)
     }
 
+camPos c = camTarget c - scale (camDistance c) (camDirection c)
+
 initCamera :: Camera
 initCamera = Camera
     { camHeightAngle = pi/6
@@ -251,7 +253,7 @@ new = do
           defObjectArray "plane" Triangles $ do
             "position"  @: Attribute_V4F
           defObjectArray "Points" Points $ do
-            "position"  @: Attribute_Float
+            "position"  @: Attribute_V3F
           defUniforms $ do
             "PointBuffer"     @: FTextureBuffer
             "CubeMap"         @: FTextureCube
@@ -309,7 +311,8 @@ onRealize mesh pipeline schema mm = do
         , EventMaskScrollMask
         , EventMaskKeyPressMask -- , EventMaskKeyReleaseMask
         ]
-    _ <- on w #event  $ onEvent  w r
+    _ <- on w #event  $ \ev -> do gLAreaMakeCurrent w
+                                  onEvent w r ev
     _ <- on w #render $ onRender w r
     _ <- on w #resize $ onResize w r
     writeIORef (mmRealized mm) $ Just r
@@ -444,8 +447,11 @@ onEvent w realized ev = do
                         h <- get mev #x
                         k <- get mev #y
                         cam <- readIORef (stCamera st)
-                        let d = computeDirection cam h k
-                        pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
+                        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)
+                        Just win <- getWidgetWindow w
+                        windowInvalidateRect win Nothing False
                         put (etype,(h,k),d)
                 _ -> do
                     mev <- get ev #motion
@@ -463,8 +469,11 @@ onEvent w realized ev = do
                     h <- get bev #x
                     k <- get bev #y
                     cam <- readIORef (stCamera st)
-                    let d = computeDirection cam h k
-                    pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
+                    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)
+                    Just win <- getWidgetWindow w
+                    windowInvalidateRect win Nothing False
                     put (etype,(h,k),d)
                 _ -> do
                     bev <- get ev #button
@@ -484,8 +493,10 @@ onEvent w realized ev = do
                     h <- get bev #x
                     k <- get bev #y
                     cam <- readIORef (stCamera st)
-                    let d = computeDirection cam h k
-                    pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
+                    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)
+                    Just win <- getWidgetWindow w
+                    windowInvalidateRect win Nothing False
                 _ -> do
                     bev <- get ev #button
                     h <- get bev #x