Use Data.Data to specify ring buffer attributes.

1 files changed, 24 insertions, 9 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index d06e905..cca9524 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -1,14 +1,17 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedLabels  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE CPP                #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE LambdaCase         #-}
+{-# LANGUAGE OverloadedLabels   #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
 module MeshSketch where
 
 import Codec.Picture             as Juicy
 import Control.Concurrent
 import Control.Monad
+import Data.Data
 import Data.Word
 import Data.Function ((&))
 import Data.Functor ((<&>))
@@ -44,6 +47,7 @@ import Text.Printf
 
 import CubeMap
 import GLWidget (nullableContext, withCurrentGL)
+import LambdaCube.GL.Input.Type
 import LambdaCube.GL.HMatrix
 import LambdaCubeWidget (loadPipeline,DynamicPipeline(..))
 import Animator
@@ -52,6 +56,7 @@ import InfinitePlane
 import MtlParser (ObjMaterial(..))
 import Matrix
 import PointPrimitiveRing
+import MaskableStream (AttributeKey,(@<-))
 
 
 prettyDebug :: GL.DebugMessage -> String
@@ -75,6 +80,14 @@ setupGLDebugging = do
 
 type Plane = Vector Float
 
+data RingPoint = RingPoint
+    { rpPosition :: AttributeKey (GLVector 3 Float)
+    }
+    deriving Data
+
+ringPointAttr :: String -> String
+ringPointAttr ('r':'p':c:cs) = toLower c : cs
+
 -- State created by uploadState.
 data State = State
     { stAnimator   :: Animator
@@ -84,7 +97,7 @@ data State = State
     , stSkybox     :: IORef Int
     , stSkyTexture :: IORef TextureCubeData
     , stDragFrom   :: IORef (Maybe (Vector Float,Camera))
-    , stRingBuffer :: Ring
+    , stRingBuffer :: Ring RingPoint
     , stPenDown    :: IORef Bool
     , stPlane      :: IORef (Maybe Plane)
     , stDragPlane  :: IORef (Maybe (Vector Float,Plane))
@@ -183,7 +196,7 @@ uploadState obj glarea storage = do
     -- grid plane
     uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" []
 
-    ring <- newRing storage 100
+    ring <- newRing storage 100 ringPointAttr
 
     -- setup FrameClock
     w <- toWidget glarea
@@ -560,7 +573,9 @@ pushRing w st h k = do
     plane <- readIORef (stPlane st)
     d <- worldCoordinates st h k plane
     Just win <- getWidgetWindow w
-    pushBack (stRingBuffer st) (d!0) (d!1) (d!2)
+    pushBack (stRingBuffer st) $ do
+        RingPoint{..} <- return $ rKeys (stRingBuffer st)
+        rpPosition @<- d
     windowInvalidateRect win Nothing False
     return d