1 files changed, 29 insertions, 18 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index dc0adf1..4ddfec0 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -96,21 +96,22 @@ ringPointAttr ('r':'p':c:cs) = toLower c : cs
 
 -- State created by uploadState.
 data State = State
-    { stAnimator   :: Animator
-    , stCamera     :: IORef Camera
-    , stFullscreen :: IO ()
-    , stSkyboxes   :: Skyboxes
-    , stSkybox     :: IORef Int
-    , stSkyTexture :: IORef TextureCubeData
-    , stDragFrom   :: IORef (Maybe (Vector Float,Camera))
-    , stDataPoints :: MV.MVector RealWorld Vector.Point
-    , stDataRing   :: RingBuffer Vector.Point
-    , stRingBuffer :: RingBuffer (GPU.Update RingPoint)
-    , stPenDown    :: IORef Bool
-    , stPlane      :: IORef (Maybe Plane)
-    , stDragPlane  :: IORef (Maybe (Vector Float,Plane))
-    , stRecentPts  :: IORef (Giver (Vector Double))
-    , stAngle      :: IORef Int
+    { stAnimator     :: Animator
+    , stCamera       :: IORef Camera
+    , stFullscreen   :: IO ()
+    , stSkyboxes     :: Skyboxes
+    , stSkybox       :: IORef Int
+    , stSkyTexture   :: IORef TextureCubeData
+    , stDragFrom     :: IORef (Maybe (Vector Float,Camera))
+    , stDataPoints   :: MV.MVector RealWorld Vector.Point
+    , stDataRing     :: RingBuffer Vector.Point
+    , stRingBuffer   :: RingBuffer (GPU.Update RingPoint)
+    , stCurveSpecial :: RingBuffer (GPU.Update RingPoint)
+    , stPenDown      :: IORef Bool
+    , stPlane        :: IORef (Maybe Plane)
+    , stDragPlane    :: IORef (Maybe (Vector Float,Plane))
+    , stRecentPts    :: IORef (Giver (Vector Double))
+    , stAngle        :: IORef Int
     }
 
 initCamera :: Camera
@@ -172,7 +173,8 @@ uploadState obj glarea storage = do
     let bufsize = 1000
     v <- MV.unsafeNew bufsize
     pts <- newRing bufsize (Vector.new v)
-    ring <- newRing bufsize (GPU.new "Points" storage ringPointAttr bufsize)
+    ring <- newRing bufsize (GPU.new LineStrip "Curve" storage ringPointAttr bufsize)
+    cpts <- newRing 100 (GPU.new PointList "Points" storage ringPointAttr 100)
 
     -- setup FrameClock
     w <- toWidget glarea
@@ -215,6 +217,7 @@ uploadState obj glarea storage = do
             , stDataPoints   = v
             , stDataRing     = pts
             , stRingBuffer   = ring
+            , stCurveSpecial = cpts
             , stPenDown      = pendown
             , stPlane        = plane
             , stDragPlane    = dragPlane
@@ -294,7 +297,10 @@ new = do
             "uvw"       @: Attribute_V3F
           defObjectArray "plane" Triangles $ do
             "position"  @: Attribute_V4F
-          defObjectArray "Points" Lines $ do
+          defObjectArray "Curve" Lines $ do
+            "position"  @: Attribute_V3F
+            "color"     @: Attribute_V3F
+          defObjectArray "Points" Points $ do
             "position"  @: Attribute_V3F
             "color"     @: Attribute_V3F
           defUniforms $ do
@@ -607,8 +613,8 @@ pushRing w st endpt h k c = do
                 n = round $ θ/(pi/12)
             m <- readIORef (stAngle st)
             let isSpecial = x<0.3 -- || δ<0.5
+            bb <- worldCoordinates st (b!0) (b!1) plane
             go <- if (m /= n || isSpecial) then do
-                        bb <- worldCoordinates st (b!0) (b!1) plane
                         updateBack (stDataRing st) (Vector.Point (b!0) (b!1))
                         updateBack (stRingBuffer st) $ \RingPoint{..} -> do
                             rpPosition @<- bb
@@ -627,6 +633,10 @@ pushRing w st endpt h k c = do
             bool updateBack pushBack go (stRingBuffer st) $ \RingPoint{..} -> do
                 rpPosition @<- aa
                 rpColor    @<- yellow
+            when isSpecial $ do
+                pushBack (stCurveSpecial st) $ \RingPoint{..} -> do
+                    rpPosition @<- bb
+                    rpColor    @<- yellow
         withEndpt = do
             pushBack (stDataRing st) (Vector.Point h k)
             pushBack (stRingBuffer st) $ \RingPoint{..} -> do
@@ -697,6 +707,7 @@ onEvent w realized ev = do
                     writeIORef (stRecentPts st) Give0
                     clearRing (stRingBuffer st)
                     clearRing (stDataRing st)
+                    clearRing (stCurveSpecial st)
                     d <- pushRing w st True h k red
                     Just win <- getWidgetWindow w
                     windowInvalidateRect win Nothing False