Refactor poking tuples

src/Picture/Render.hs

@@ -141,9 +141,41 @@ theFold :: (Ptr Float,Ptr Float)
         -> (Ptr Float,Ptr Float,Ptr Float)
         -> (Ptr Float,Ptr Float,Ptr Float)
         -> (Ptr Float,Ptr Float)
-        -> F.FoldM IO RenderType (Int,Int,Int,Int)
-theFold pas pbs pcs pds = (,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
+        -> (Ptr Float,Ptr Float,Ptr Float)
+        -> F.FoldM IO RenderType (Int,Int,Int,Int,Int)
+theFold pas pbs pcs pds pes 
+    = (,,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
                                     <*> pokeLineFold pds
+                                    <*> pokeThreePtrsWith pokeArc pes
+
+type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
+
+pokeThreePtrsWith :: (ThreePtrs -> Int -> RenderType -> IO Int)
+    -> ThreePtrs -> F.FoldM IO RenderType Int
+pokeThreePtrsWith pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
+
+pokeArc:: ThreePtrs -> Int -> RenderType -> IO Int
+pokeArc (pa,pb,pc) n (RenderArc ((x,y,z),(r,g,b,a),(s,t,u,v)))
+    | n > 20000 * 2 = return n
+    | otherwise = return n
+pokeArc _ n _ = return n
+
+pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
+pokeTwoOff ptr n (x,y) = do
+    pokeElemOff ptr (2*n+0) x
+    pokeElemOff ptr (2*n+1) y
+pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO ()
+pokeThreeOff ptr n (x,y,z) = do
+    pokeElemOff ptr (3*n+0) x
+    pokeElemOff ptr (3*n+1) y
+    pokeElemOff ptr (3*n+2) z
+pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
+pokeFourOff ptr n (x,y,z,w) = do
+    pokeElemOff ptr (4*n+0) x
+    pokeElemOff ptr (4*n+1) y
+    pokeElemOff ptr (4*n+2) z
+    pokeElemOff ptr (4*n+3) w
+
 
 pokeLineFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
 pokeLineFold (pa,pb) = F.FoldM
@@ -155,16 +187,11 @@ pokeLine pa pb n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
 pokeLine _  _  n _               = return n
 
 pokeLineVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
-pokeLineVert pa pb n ((x,y,z),(r,g,b,a))
+pokeLineVert pa pb n (p,c)
     | n > 20000 * 2 = return n
     | otherwise = do
-        pokeElemOff pa (3*n+0) x
-        pokeElemOff pa (3*n+1) y
-        pokeElemOff pa (3*n+2) z
-        pokeElemOff pb (4*n+0) r
-        pokeElemOff pb (4*n+1) g
-        pokeElemOff pb (4*n+2) b
-        pokeElemOff pb (4*n+3) a
+        pokeThreeOff pa n p
+        pokeFourOff  pb n c
         return (n+1)
 
 pokeCirc :: Ptr Float -> Ptr Float ->  Ptr Float -> Int -> RenderType -> IO Int
@@ -172,17 +199,12 @@ pokeCirc pa pb pc n (RenderCirc vs) = pokeCircVert pa pb pc n vs
 pokeCirc _  _  _  n _               = return n
 
 pokeCircVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Float) -> IO Int
-pokeCircVert pa pb pc n ((x,y,z),(r,g,b,a),s)
+pokeCircVert pa pb pc n (p,c,s)
     | n > 20000 * 2 = return n
     | otherwise = do
-        pokeElemOff pa (3*n+0) x
-        pokeElemOff pa (3*n+1) y
-        pokeElemOff pa (3*n+2) z
-        pokeElemOff pb (4*n+0) r
-        pokeElemOff pb (4*n+1) g
-        pokeElemOff pb (4*n+2) b
-        pokeElemOff pb (4*n+3) a
-        pokeElemOff pc n s
+        pokeThreeOff pa n p
+        pokeFourOff  pb n c
+        pokeElemOff  pc n s
         return (n+1)
 
 pokeText :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
@@ -190,18 +212,12 @@ pokeText pa pb pc n (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
 pokeText _  _  _  n _               = return n
 
 pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point2) -> IO Int
-pokeTextVert pa pb pc n ((x,y,z),(r,g,b,a),(s,t))
+pokeTextVert pa pb pc n (p,c,t)
     | n > 20000 * 2 = return n
     | otherwise = do
-        pokeElemOff pa (3*n+0) x
-        pokeElemOff pa (3*n+1) y
-        pokeElemOff pa (3*n+2) z
-        pokeElemOff pb (4*n+0) r
-        pokeElemOff pb (4*n+1) g
-        pokeElemOff pb (4*n+2) b
-        pokeElemOff pb (4*n+3) a
-        pokeElemOff pc (2*n+0) s
-        pokeElemOff pc (2*n+1) t
+        pokeThreeOff pa n p
+        pokeFourOff  pb n c
+        pokeTwoOff   pc n t
         return (n+1)
 
 pokePic :: Ptr Float -> Ptr Float -> FTree RenderType -> IO Int
@@ -213,16 +229,11 @@ pokePoly pa pb n (RenderPoly vs) = foldM (pokeVert pa pb) n vs
 pokePoly _  _  n _               = return n
 
 pokeVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
-pokeVert pa pb n ((x,y,z),(r,g,b,a))
+pokeVert pa pb n (p,c)
     | n > 20000 * 2 = return n
     | otherwise = do
-        pokeElemOff pa (3*n+0) x
-        pokeElemOff pa (3*n+1) y
-        pokeElemOff pa (3*n+2) z
-        pokeElemOff pb (4*n+0) r
-        pokeElemOff pb (4*n+1) g
-        pokeElemOff pb (4*n+2) b
-        pokeElemOff pb (4*n+3) a
+        pokeThreeOff pa n p
+        pokeFourOff  pb n c
         return (n+1)
 
 translate3 :: Float -> Float -> Point3 -> Point3
@@ -250,11 +261,12 @@ renderPicture' pdata zoom (winx,winy) pic = do
     let firstIndex = 0
         numArcVs = 0
 
-    (nTriVs,numVert',numCircVs,nLineVs) 
+    (nTriVs,numVert',numCircVs,nLineVs,nArcVs) 
         <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
                                           (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
                                           (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
                                           (_ptrLinePos pdata, _ptrLineCol pdata)
+                                          (_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata)
                    ) $ picToFTree pic
 
     depthFunc $= Just Less