From 315d96fb6f76985ec9269a434039f3afca983d5a Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Thu, 30 May 2019 00:09:21 -0400
Subject: Factored gpu-backend out of RingBuffer, wrote vector-backend.

---
 PointPrimitiveRing.hs | 109 --------------------------------------------------
 1 file changed, 109 deletions(-)
 delete mode 100644 PointPrimitiveRing.hs

(limited to 'PointPrimitiveRing.hs')

diff --git a/PointPrimitiveRing.hs b/PointPrimitiveRing.hs
deleted file mode 100644
index d4fafae..0000000
--- a/PointPrimitiveRing.hs
+++ /dev/null
@@ -1,109 +0,0 @@
-{-# LANGUAGE LambdaCase, RecordWildCards, DataKinds #-}
-module PointPrimitiveRing where
-
-import Control.Monad
-import Control.Monad.Writer
-import Data.Data
-import Data.Dependent.Sum
-import Data.Foldable
-import Data.Function
-import Data.Int
-import Data.IORef
-import Data.Maybe
-import Data.Some
-import Data.Word
-import qualified Data.Map.Strict as Map
-import qualified Data.Vector as V
-         ;import Data.Vector as V ((!),(//))
-import Foreign.C.Types (CPtrdiff)
-import Foreign.Marshal
-import Foreign.Ptr
-import Foreign.Storable
-
-import LambdaCube.GL      as LC
-import LambdaCube.GL.Data -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer)
-import LambdaCube.GL.Mesh as LC
-import LambdaCube.GL.Type
-import LambdaCube.IR      as LC
-import LambdaCube.GL.Util
-import LambdaCube.GL.Input.Type
-import LambdaCube.GL.Input hiding (createObjectCommands)
-
-import AttributeData
-
--- import Graphics.GL.Core33
-
-import MaskableStream
-
-data Ring keys = Ring
-    { rBufferObject :: Buffer
-    , rStorage      :: GLStorage
-    , rObject       :: Object
-    , rSize         :: IORef Int -- Current count of vertices in the ring buffer.
-    , rBack         :: IORef Int -- Where next vertex will be added.
-    , ringCapacity  :: Int       -- Maximum number of vertices in buffer.
-    , rKeys         :: keys
-    }
-
-newRing :: Data keys => GLStorage -> Int -> (String -> String) -> IO (Ring keys)
-newRing storage sz toAttr = fix $ \retProxy -> do
-    let paramProxy = paramProxy' retProxy
-            where paramProxy' :: io (ring keys) -> Proxy keys
-                  paramProxy' _ = Proxy
-    startRef <- newIORef 0
-    sizeRef <- newIORef 0
-    let ps = fieldParameters paramProxy toAttr
-    putStrLn $ "Ring params: " ++ show ps
-    gd0 <- uploadDynamicBuffer sz ps
-    let gd = gd0 { dPrimitive = LineStrip }
-    Just keys <- return $ lookupAttrKeys (lookupAttributeKey gd . toAttr)
-    obj <- addToObjectArray storage "Points" [] gd
-    readIORef (objCommands obj) >>= mapM_ print
-    let r = Ring
-            { rBufferObject = streamBuffer $ head $ Map.elems (dStreams gd)
-            , rStorage      = storage
-            , rObject       = obj
-            , rSize         = sizeRef
-            , rBack         = startRef
-            , ringCapacity  = sz
-            , rKeys         = keys
-            }
-    updateRingCommands r
-    return r
-
-clearRing :: Ring keys -> IO ()
-clearRing r = do
-    writeIORef (rBack r) 0
-    writeIORef (rSize r) 0
-    updateRingCommands r
-
-updateRingCommands :: Ring keys -> IO ()
-updateRingCommands r = do
-    back <- fromIntegral <$> readIORef (rBack r)
-    size  <- fromIntegral <$> readIORef (rSize r)
-    let mask 0   = []
-        mask cnt
-            | cnt==size = [(0,cnt)]
-            | otherwise = case cnt + back - size of
-                front | front > cnt -> [(front - cnt,size)]
-                      | otherwise   -> [(0,back), (front,cnt - front)]
-    updateCommands (rStorage r) (rObject r) mask
-    -- readIORef (objCommands $ rObject r) >>= mapM_ print
-    return ()
-
-pushBack :: Ring keys -> (keys -> Writer [DSum AttributeKey GLUniformValue] a) -> IO ()
-pushBack r attrs = do
-    back <- readIORef $ rBack r
-    writeIORef (rBack r) (mod (back + 1) (ringCapacity r))
-    updateAttributes back $ attrs (rKeys r)
-    sz <- readIORef (rSize r)
-    when (sz < ringCapacity r) $ writeIORef (rSize r) (sz + 1)
-    updateRingCommands r
-
-updateBack :: Ring keys -> (keys -> Writer [DSum AttributeKey GLUniformValue] a) -> IO ()
-updateBack r attrs = do
-    back <- readIORef $ rBack r
-    updateAttributes (mod (back - 1) (ringCapacity r)) $ attrs (rKeys r)
-
-updateRingUniforms :: GLStorage -> Ring keys -> IO ()
-updateRingUniforms _ _ = return ()
-- 
cgit v1.2.3