Small optimisations

src/Picture/Data.hs

@@ -49,13 +49,14 @@ instance Foldable FTree where
 {- Tree with values at and only at the leaves. -}
 data LTree a
     = LBranches [LTree a]
-    | LLeaf a
+    | LLeaf !a
 instance Foldable LTree where
     foldMap g (LBranches ts) = mconcat $ map (foldMap g) ts
     foldMap g (LLeaf a) = g a
     {-# INLINE foldMap #-}
     foldr _ x (LBranches []) = x
-    foldr g x (LBranches (t:ts)) = foldr g (foldr g x (LBranches ts)) t
+    foldr g x (LBranches (t:ts)) = foldr g (foldr g x t) (LBranches ts)
+    --foldr g x (LBranches (t:ts)) = foldr g (foldr g x (LBranches ts)) t
     foldr g x (LLeaf y) = g y x
     {-# INLINE foldr #-}
     foldl' _ x (LBranches []) = x

src/Picture/Tree.hs

@@ -21,7 +21,7 @@ picToLTree
     :: Maybe Int -- ^ Layer filter. Draw 'Nothing' when value is the same as at the leaf.
     -> Picture
     -> LTree RenderType
-{-# INLINE picToLTree #-}
+--{-# INLINE picToLTree #-}
 picToLTree _ (Polygon ps)
     = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
 picToLTree _ (PolygonZ ps z)
@@ -162,7 +162,7 @@ white = (1,1,1,1)
 black = (0,0,0,1)
 
 overPos :: (Point3 -> Point3) -> RenderType -> RenderType
-{-# INLINE overPos #-}
+--{-# INLINE overPos #-}
 overPos f (RenderPoly vs) = RenderPoly $ map (first f) vs
 overPos f (RenderLine vs) = RenderLine $ map (first f) vs
 overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
@@ -173,7 +173,7 @@ overPos f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos _ _ = undefined
 
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
-{-# INLINE overCol #-}
+--{-# INLINE overCol #-}
 overCol f (RenderPoly vs)     = RenderPoly    $ map (second f) vs
 overCol f (RenderLine vs)     = RenderLine    $ map (second f) vs
 overCol f (RenderEllipse vs)  = RenderEllipse $ map (second f) vs
@@ -183,31 +183,28 @@ overCol f (RenderArc vs)      = RenderArc     $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol f (RenderPolyZ vs)    = RenderPolyZ   $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol _ _ = undefined
 
+-- no premature optimisation, consider changing to use texture arrays
 stringToList :: String -> [(Point3,Point4,Point2)]
 {-# INLINE stringToList #-}
-stringToList s = concat $ zipWith (map . f)
-    [0,0.9*dimText..]
-    $ map charToTuple s
+--stringToList s = concat $ zipWith charToTuple [0,0.9*dimText ..] s
+stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s
   where
-    f y (a,b,c) = (translate3 y 0 a,b,c)
-    --where dimText = 100
-dimText :: Float
-dimText = 100
+    dimText = 100
 
-charToTuple :: Char -> [(Point3,Point4,Point2)]
+charToTuple :: Float -> Char -> [(Point3,Point4,Point2)]
 {-# INLINE charToTuple #-}
-charToTuple c = 
-    [((-50,-100,0),    white,(offset,1))
-    ,((-50,100,0),     white,(offset,0))
-    ,(( 50,100,0),   white,(offset+1,0))
-    ,((-50,-100,0),    white,(offset,1))
-    ,(( 50,-100,0),  white,(offset+1,1))
-    ,(( 50,100,0),   white,(offset+1,0))
+charToTuple x c = 
+    [((x-50,-100,0),    white,(offset,1))
+    ,((x-50,100,0),     white,(offset,0))
+    ,((x+50,100,0),   white,(offset+1,0))
+    ,((x-50,-100,0),    white,(offset,1))
+    ,((x+50,-100,0),  white,(offset+1,1))
+    ,((x+50,100,0),   white,(offset+1,0))
     ]
   where 
     offset = fromIntegral (fromEnum c) - 32
 
-{- Translate a 3D vector in the x and y directions. -}
-translate3 :: Float -> Float -> Point3 -> Point3
-{-# INLINE translate3 #-}
-translate3 a b (x,y,z) = (x+a,y+b,z)
+--{- Translate a 3D vector in the x and y directions. -}
+--translate3 :: Float -> Float -> Point3 -> Point3
+--{-# INLINE translate3 #-}
+--translate3 a b (x,y,z) = (x+a,y+b,z)