1 files changed, 27 insertions, 40 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 1019d72..14b3ebc 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -68,7 +68,8 @@ import RingBuffer
 import MaskableStream (AttributeKey,(@<-))
 import SmallRing
 import Camera
-
+import FitCurves
+import Bezier
 
 prettyDebug :: GL.DebugMessage -> String
 prettyDebug (GL.DebugMessage src typ (GL.DebugMessageID mid) severity msg) = unwords ws
@@ -89,13 +90,6 @@ setupGLDebugging = do
     GL.debugMessageControl (GL.MessageGroup Nothing Nothing Nothing) GL.$= GL.Enabled
     GL.debugMessageCallback GL.$= Just pdebug
 
-type Plane = Vector Float
-
-data RingPoint = RingPoint
-    { rpPosition :: AttributeKey (GLVector 3 Float)
-    , rpColor :: AttributeKey (GLVector 3 Float)
-    }
-    deriving Data
 
 ringPointAttr :: String -> String
 ringPointAttr ('r':'p':c:cs) = toLower c : cs
@@ -237,12 +231,6 @@ destroyState glarea st = do
     -- widgetRemoveTickCallback glarea (stTickCallback st)
     return ()
 
-deg30 :: Float
-deg30 = pi/6
-
-ĵ :: Vector Float
-ĵ = fromList [0,1,0]
-
 computePlaneModel :: Vector Float -> Matrix Float
 computePlaneModel plane = if n̂ == ĵ then translate4 p
                                     else translate4 p <> rotate4 cosθ axis
@@ -258,7 +246,7 @@ whirlingCamera st = Animation $ \_ t -> do
     let tf = realToFrac t :: Float
         rot = rotMatrixZ (-tf/2) <> rotMatrixX (-tf/pi)
     modifyIORef (stCamera st) $ \cam -> cam
-                            { camUp            = fromList [0,1,0] <# rot
+                            { camUp            = ĵ <# rot
                             , camDirection     = (scale (1/camDistance cam) $ fromList [-2,-2,-10]) <# rot
                             , camWorldToScreen = Nothing
                             , camScreenToWorld = Nothing
@@ -571,25 +559,28 @@ worldCoordinates :: State -> Double -> Double -> Maybe (Vector Float) -> IO (Vec
 worldCoordinates st h k mplane = do
     pv <- atomicModifyIORef' (stCamera st) projectionView
     cam <- readIORef (stCamera st)
-    let q0 = fromList [ 2 * realToFrac h/camWidth cam - 1
-                      , 1 - 2 * realToFrac k/camHeight cam
-                      , 1
-                      , 1
-                      ] :: Vector Float
-        q1 = pv #> q0
-        q2 = scale (1 /(q1!3)) $ G.init q1
-        p = camPos cam
-        d = q2 - p
-        d̂ = unit 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̂
+    return $ camWorldCoordinates cam h k mplane
+
+fitCurves :: State -> IO ()
+fitCurves st = do
+    _ <- atomicModifyIORef' (stCamera st) projectionView
+    cam <- readIORef (stCamera st)
+    plane <- readIORef (stPlane st)
+    mask <- ringMask (stDataRing st)
+    let max_curve_pts = ringCapacity (stRingBuffer st)
+        buf = rBuffer (stRingBuffer st)
+        dta = stDataPoints st
+    -- dta_cnt <- readIORef (rSize $ stDataRing st)
+    -- when (dta_cnt > 4) $ do
+    -- when (idx > 0) $
+    midx <- fitCurve1 cam plane mask max_curve_pts buf dta
+    forM_ midx $ \idx -> do
+        putStrLn $ "idx = " ++ show idx
+        -- syncBuffer buf $ \cnt -> [(0,max cnt $ fromIntegral idx)]
+        writeIORef (rBack $ stRingBuffer st) idx
+        writeIORef (rSize $ stRingBuffer st) idx
+        syncRing (stRingBuffer st)
+
 
 pushRing :: IsWidget w => w -> State
                             -> Bool -- ^ True when press/release.
@@ -647,14 +638,9 @@ pushRing w st endpt h k c = do
     else do
         fromMaybe withEndpt $ take3 withTriple g
     windowInvalidateRect win Nothing False
+    fitCurves st
     return d
 
-white,red,yellow,blue :: Vector Float
-white  = fromList [1,1,1]
-yellow = fromList [1,1,0]
-blue   = fromList [0,0,1]
-red    = fromList [1,0,0]
-
 onEvent :: IsWidget w => w -> Realized -> Event -> IO Bool
 onEvent w realized ev = do
     msrc <- eventGetSourceDevice ev
@@ -710,6 +696,7 @@ onEvent w realized ev = do
                     writeIORef (stAngle st) 0
                     writeIORef (stRecentPts st) Give0
                     clearRing (stRingBuffer st)
+                    clearRing (stDataRing st)
                     d <- pushRing w st True h k red
                     Just win <- getWidgetWindow w
                     windowInvalidateRect win Nothing False