diff options
Diffstat (limited to 'PointPrimitiveRing.hs')
-rw-r--r-- | PointPrimitiveRing.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/PointPrimitiveRing.hs b/PointPrimitiveRing.hs index acca3ec..f55e08e 100644 --- a/PointPrimitiveRing.hs +++ b/PointPrimitiveRing.hs | |||
@@ -2,10 +2,13 @@ | |||
2 | module PointPrimitiveRing where | 2 | module PointPrimitiveRing where |
3 | 3 | ||
4 | import Control.Monad | 4 | import Control.Monad |
5 | import Data.Data | ||
5 | import Data.Foldable | 6 | import Data.Foldable |
7 | import Data.Function | ||
6 | import Data.Int | 8 | import Data.Int |
7 | import Data.IORef | 9 | import Data.IORef |
8 | import Data.Maybe | 10 | import Data.Maybe |
11 | import Data.Some | ||
9 | import Data.Word | 12 | import Data.Word |
10 | import qualified Data.Map.Strict as Map | 13 | import qualified Data.Map.Strict as Map |
11 | import qualified Data.Vector as V | 14 | import qualified Data.Vector as V |
@@ -32,9 +35,9 @@ data Ring = Ring | |||
32 | { rBufferObject :: Buffer | 35 | { rBufferObject :: Buffer |
33 | , rStorage :: GLStorage | 36 | , rStorage :: GLStorage |
34 | , rObject :: Object | 37 | , rObject :: Object |
35 | , rSize :: IORef Int -- Current count of Floats in the ring buffer. | 38 | , rSize :: IORef Int -- Current count of vertices in the ring buffer. |
36 | , rBack :: IORef Int -- Where next vector will be added. | 39 | , rBack :: IORef Int -- Where next vertex will be added. |
37 | , ringCapacity :: CPtrdiff -- Maximum number of floats in buffer. | 40 | , ringCapacity :: Int -- Maximum number of vertices in buffer. |
38 | , rPosition :: AttributeKey (GLVector 3 Float) | 41 | , rPosition :: AttributeKey (GLVector 3 Float) |
39 | } | 42 | } |
40 | 43 | ||
@@ -54,7 +57,7 @@ newRing storage sz = do | |||
54 | , rObject = obj | 57 | , rObject = obj |
55 | , rSize = sizeRef | 58 | , rSize = sizeRef |
56 | , rBack = startRef | 59 | , rBack = startRef |
57 | , ringCapacity = 3 * fromIntegral sz | 60 | , ringCapacity = sz |
58 | , rPosition = k | 61 | , rPosition = k |
59 | } | 62 | } |
60 | updateRingCommands r | 63 | updateRingCommands r |
@@ -65,9 +68,11 @@ updateRingCommands r = do | |||
65 | back <- fromIntegral <$> readIORef (rBack r) | 68 | back <- fromIntegral <$> readIORef (rBack r) |
66 | size <- fromIntegral <$> readIORef (rSize r) | 69 | size <- fromIntegral <$> readIORef (rSize r) |
67 | let mask 0 = [] | 70 | let mask 0 = [] |
68 | mask cnt = case cnt + back - size of | 71 | mask cnt |
69 | front | front > cnt -> [(front - cnt,size)] | 72 | | cnt==size = [(0,cnt)] |
70 | | otherwise -> [(0,back), (front,cnt - front)] | 73 | | otherwise = case cnt + back - size of |
74 | front | front > cnt -> [(front - cnt,size)] | ||
75 | | otherwise -> [(0,back), (front,cnt - front)] | ||
71 | updateCommands (rStorage r) (rObject r) mask | 76 | updateCommands (rStorage r) (rObject r) mask |
72 | readIORef (objCommands $ rObject r) >>= mapM_ print | 77 | readIORef (objCommands $ rObject r) >>= mapM_ print |
73 | return () | 78 | return () |
@@ -75,12 +80,12 @@ updateRingCommands r = do | |||
75 | pushBack :: Ring -> Float -> Float -> Float -> IO () | 80 | pushBack :: Ring -> Float -> Float -> Float -> IO () |
76 | pushBack r x y z = do | 81 | pushBack r x y z = do |
77 | back <- readIORef $ rBack r | 82 | back <- readIORef $ rBack r |
78 | writeIORef (rBack r) (mod (back + 1) (fromIntegral $ ringCapacity r `div` 3)) | 83 | writeIORef (rBack r) (mod (back + 1) (ringCapacity r)) |
79 | updateAttributes back $ do | 84 | updateAttributes back $ do |
80 | rPosition r @<- V3 x y z -- (fromList [x,y,z] :: Vector Float) | 85 | rPosition r @<- V3 x y z -- (fromList [x,y,z] :: Vector Float) |
81 | sz <- readIORef (rSize r) | 86 | sz <- readIORef (rSize r) |
82 | putStrLn $ "pushBack "++show (sz,back,(x,y,z)) | 87 | putStrLn $ "pushBack "++show (sz,back,(x,y,z)) |
83 | when (sz < fromIntegral (ringCapacity r `div` 3)) $ do | 88 | when (sz < ringCapacity r) $ do |
84 | writeIORef (rSize r) (sz + 1) | 89 | writeIORef (rSize r) (sz + 1) |
85 | updateRingCommands r | 90 | updateRingCommands r |
86 | 91 | ||