Refactor text rendering

src/Picture/Data.hs

@@ -16,7 +16,7 @@ import Geometry.Data
 data RenderType
     = RenderPoly [(Point3,Point4)]
     | RenderBezQ [(Point3,Point4,Point4)]
-    | RenderText [(Point3,Point4,Point3)]
+    | RenderText [(Point3,Point4,Point2)]
     | RenderArc  (Point3,Point4,Point4)
     | RenderLine [(Point3,Point4)]
     | RenderEllipse [(Point3,Point4)]

src/Picture/Render.hs

@@ -206,37 +206,20 @@ renderBackground pdata rot camZoom (tranx,trany) (winx,winy) = do
     textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata)
     drawArrays Points 0 1
 
-setCommonUniforms
+setPerpMatrixUniforms
     :: RenderData
     -> Float            -- ^ Rotation
     -> Float            -- ^ Zoom
     -> (Float,Float)    -- ^ Translation
     -> (Float,Float)    -- ^ Window size
+    -> (Float,Float)    -- ^ ViewFrom
     -> IO ()
-setCommonUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do
-    setShaderUniforms rot camZoom (tranx,trany) (winx,winy) 
-        ( extractProgAndUnis (_lightingFloorShader pdata) 
-        : extractProgAndUnis (_lightingOccludeShader pdata) 
-        : extractProgAndUnis (_lightingWallShader pdata) 
-        : extractProgAndUnis (_backgroundShader pdata) 
-        : extractProgAndUnis (_textureShader pdata) 
-        : map extractProgAndUnis (_pictureShaders pdata)
-        )
-
-setIsoMatrixUniforms 
-    :: RenderData
-    -> Float            -- ^ Rotation
-    -> Float            -- ^ Zoom
-    -> (Float,Float)    -- ^ Translation
-    -> (Float,Float)    -- ^ Window size
-    -> IO ()
-setIsoMatrixUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do
-    setShaderUniforms rot camZoom (tranx,trany) (winx,winy) 
-        ( extractProgAndUnis (_lightingFloorShader pdata) 
-        : extractProgAndUnis (_backgroundShader pdata) 
-        : extractProgAndUnis (_textureShader pdata)
-        : extractProgAndUnis (_textureArrayShader pdata)
-        : map extractProgAndUnis (_pictureShaders pdata)
+setPerpMatrixUniforms pdata rot czoom trans wins vfs = mapM_ (setPerpMatUniform rot czoom trans wins vfs)
+    $ ( (_lightingFloorShader pdata) 
+        : (_backgroundShader pdata) 
+        : (_textureShader pdata)
+        : (_textureArrayShader pdata)
+        : (_pictureShaders pdata)
         )
 
 renderShader
@@ -252,12 +235,6 @@ renderShader shad dat = do
     eticks <- SDL.ticks
     return $ eticks - sticks
 
---renderPictureLayer
---    :: PictureShaderData
---    -> Picture
---    -> IO Word32
---renderPictureLayer 
-
 renderFoldable
     :: Foldable f
     => RenderData

src/Picture/Tree.hs

@@ -70,9 +70,9 @@ white, black :: Color
 white = (1,1,1,1)
 black = (0,0,0,1)
 
-scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3)
+scaleT :: (Float,Float) -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
 {-# INLINE scaleT #-}
-scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
+scaleT (x,y) (a,b,(o,s)) = (a,b,(o,s))
 
 overPos :: (Point3 -> Point3) -> RenderType -> RenderType
 {-# INLINE overPos #-}
@@ -104,19 +104,29 @@ overSca :: (Point2 -> Point2) -> RenderType -> RenderType
 overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs
 overSca _ p = p
 
-stringToList :: String -> [(Point3,Point4,Point3)]
+stringToList :: String -> [(Point3,Point4,Point2)]
 {-# INLINE stringToList #-}
-stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
-                         [0,0.9*dimText..]
-                         $ map charToTuple s
+stringToList s = concat $ zipWith (\x -> map (f x))
+    [0,0.9*dimText..]
+    $ map charToTuple s
+  where
+    f y (a,b,c) = (translate3 y 0 a,b,c)
     --where dimText = 100
 dimText :: Float
 dimText = 100
 
-charToTuple :: Char -> (Point3,Point4,Point3)
+charToTuple :: Char -> [(Point3,Point4,Point2)]
 {-# INLINE charToTuple #-}
-charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
-    where offset = fromIntegral (fromEnum c) - 32
+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))
+    ]
+  where 
+    offset = fromIntegral (fromEnum c) - 32
 
 {- Translate a 3D vector in the x and y directions. -}
 translate3 :: Float -> Float -> Point3 -> Point3