From d27c5e7ff48a76558769646f3c2f6750c70765b2 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 26 Jul 2021 12:51:01 +0200
Subject: [PATCH] Tweak single bind pass

---
 src/Picture.hs           | 52 ++++++++++++++++++++++++++++++----------
 src/Shader/Parameters.hs |  2 +-
 2 files changed, 40 insertions(+), 14 deletions(-)

diff --git a/src/Picture.hs b/src/Picture.hs
index 39fef412c..61e4552d7 100644
--- a/src/Picture.hs
+++ b/src/Picture.hs
@@ -148,23 +148,27 @@ extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = map $ second $ overCol (const c)
+--color c = map $ second $ overCol (const c)
+color c = map $ overCol' (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
 
 translate :: Float -> Float -> Picture -> Picture
-{-# INLINE translate #-}
-translate x y = map $ second $ overPos (translate3 x y)
+--{-# INLINE translate #-}
+--translate x y = map $ second $ overPos (translate3 x y)
+translate x y = map $ overPos' (translate3 x y)
 
 setDepth :: Float -> Picture -> Picture
-{-# INLINE setDepth #-}
-setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
+--{-# INLINE setDepth #-}
+--setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
+setDepth d = map $ overPos' (\(x,y,_) -> (x,y,d))
 
 addDepth :: Float -> Picture -> Picture
-{-# INLINE addDepth #-}
-addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
+--{-# INLINE addDepth #-}
+--addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
+addDepth d = map $ overPos' (\(x,y,z) -> (x,y,z+d))
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
@@ -175,12 +179,14 @@ scale3 :: Float -> Float -> Point3 -> Point3
 scale3 a b (x,y,z) = (x*a,y*b,z)
 
 scale :: Float -> Float -> Picture -> Picture
-{-# INLINE scale #-}
-scale x y = map . second . overPos $ scale3 x y
+--{-# INLINE scale #-}
+--scale x y = map . second . overPos $ scale3 x y
+scale x y = map $ overPos' $ scale3 x y
 
 rotate :: Float -> Picture -> Picture
-{-# INLINE rotate #-}
-rotate a = map . second . overPos $ rotate3 a
+--{-# INLINE rotate #-}
+--rotate a = map . second . overPos $ rotate3 a
+rotate a = map $ overPos' $ rotate3 a
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
@@ -336,15 +342,35 @@ bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)
 greyN :: Float -> Color
 greyN x = (x,x,x,1)
 
+overPos' :: (Point3 -> Point3) -> (Int,RenderType) -> (Int,RenderType)
+--{-# INLINE overPos' #-}
+overPos' f (i,RenderPoly vs)    = (i, RenderPoly $ map (first f) vs )
+overPos' f (i,RenderText vs)    = (i, RenderText $ map (\(a,b,c) -> (f a,b,c)) vs )
+overPos' f (i,RenderBezQ vs)    = (i, RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs )
+overPos' f (i,RenderEllipse vs) = (i, RenderEllipse $ map (first f) vs )
+overPos' f (i,RenderArc vs)     = (i, RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs )
+overPos' f (i,RenderPolyZ vs)   = (i, RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs )
+overPos' _ rt = rt
+
 overPos :: (Point3 -> Point3) -> RenderType -> RenderType
---{-# INLINE overPos #-}
+{-# INLINE overPos #-}
 overPos f (RenderPoly vs) = RenderPoly $ map (first f) vs
 overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
 overPos f (RenderArc vs)  = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs
-overPos _ _ = undefined
+overPos _ rt = rt
+
+overCol' :: (Point4 -> Point4) -> (Int,RenderType) -> (Int,RenderType)
+--{-# INLINE overCol #-}
+overCol' f (i,(RenderPoly vs)   )  = (i,RenderPoly    $ map (second f) vs )
+overCol' f (i,(RenderEllipse vs))  = (i,RenderEllipse $ map (second f) vs )
+overCol' f (i,(RenderText vs)   )  = (i,RenderText    $ map (\(a,b,c) -> (a,f b,c)) vs )
+overCol' f (i,(RenderBezQ vs)   )  = (i,RenderBezQ    $ map (\(a,b,c) -> (a,f b,c)) vs )
+overCol' f (i,(RenderArc vs)    )  = (i,RenderArc     $ map (\(a,b,c) -> (a,f b,c)) vs )
+overCol' f (i,(RenderPolyZ vs)  )  = (i,RenderPolyZ   $ map (\(a,b,c) -> (a,f b,c)) vs )
+overCol' _ _ = undefined
 
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
 --{-# INLINE overCol #-}
diff --git a/src/Shader/Parameters.hs b/src/Shader/Parameters.hs
index c7c1ea299..34ca78033 100644
--- a/src/Shader/Parameters.hs
+++ b/src/Shader/Parameters.hs
@@ -12,7 +12,7 @@ floatSize = sizeOf (0.5 :: GLfloat)
 
 numDrawableElements :: Int
 {-# INLINE numDrawableElements #-}
-numDrawableElements = 70000
+numDrawableElements = 60000
 
 numSubElements :: Int
 {-# INLINE numSubElements #-}