5 files changed, 21 insertions(+), 14 deletions(-)

M Mondrian.cabal
M lib/Graphics/Rendering/Rect.hs
M lib/Graphics/Rendering/Rect/CSS.hs
M lib/Graphics/Rendering/Rect/CSS/Border.hs
M lib/Graphics/Rendering/Rect/Types.hs

@@ 20,6 20,7 @@ extra-source-files:  CHANGELOG.md
 library
   exposed-modules:     Graphics.Rendering.Rect,
                        Graphics.Rendering.Rect.Backgrounds,
+                       Graphics.Rendering.Rect.Border,
                        Graphics.Rendering.Rect.Image,
                        Graphics.Rendering.Rect.CSS,
                        Graphics.Rendering.Rect.CSS.Colour,

@@ 1,12 1,14 @@
 module Graphics.Rendering.Rect(Rect(..), Rects(..), shrink, shrink1, renderRects,
-    RectStyle(..), colour,
+    RectStyle(..), colour, border,
     Backgrounds(..), Pattern(..), Resize(..), Length(..), RadialShape(..),
+    Border(..), BorderStyle(..), topColour, rightColour, bottomColour, leftColour,
     Atlas, buildAtlas, atlasFromStyles, Texture, styleResolveImages) where
 
 import Graphics.Rendering.Rect.CSS
 import Graphics.Rendering.Rect.Backgrounds
 import Graphics.Rendering.Rect.Types
 import Graphics.Rendering.Rect.Image
+import Graphics.Rendering.Rect.Border
 
 import Linear (M44)
 import Control.Monad.IO.Class (MonadIO)


@@ 26,8 28,10 @@ renderRects :: (MonadIO m, MonadIO n) =>
         n (RectStyle Texture -> Rects -> M44 Float -> m ())
 renderRects = do
     bg <- renderBackgrounds
+    frame <- renderBorder
     return $ \style rects mat -> do
         bg (backgrounds style) rects mat
+        frame (border style) rects mat
 
 styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture
 styleResolveImages atlas self =

@@ 1,5 1,5 @@
 {-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
-module Graphics.Rendering.Rect.CSS(RectStyle(..), colour) where
+module Graphics.Rendering.Rect.CSS(RectStyle(..), colour, border) where
 
 import Stylist (PropertyParser(..))
 import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground))

@@ 29,13 29,13 @@ rightColour self = resolveColour self $ rightColour' self
 bottomColour self = resolveColour self $ bottomColour' self
 leftColour self = resolveColour self $ leftColour' self
 
-data BorderStyle = None | Solid | Dashed | Dotted | Double
+data BorderStyle = NoBorder | Solid | Dashed | Dotted | Double
     | Groove | Ridge | Inset | Outset deriving (Eq, Show, Read, Enum)
 
 style :: Token -> Maybe BorderStyle
-style (Ident "initial") = Just None
-style (Ident "none") = Just None
-style (Ident "hidden") = Just None
+style (Ident "initial") = Just NoBorder
+style (Ident "none") = Just NoBorder
+style (Ident "hidden") = Just NoBorder
 style (Ident "solid") = Just Solid
 style (Ident "dashed") = Just Dashed
 style (Ident "dotted") = Just Dotted


@@ 49,13 49,13 @@ style _ = Nothing
 instance PropertyParser Border where
     temp = Border {
         borderPallet = temp,
-        topStyle = None,
+        topStyle = NoBorder,
         topColour' = Nothing,
-        rightStyle = None,
+        rightStyle = NoBorder,
         rightColour' = Nothing,
-        bottomStyle = None,
+        bottomStyle = NoBorder,
         bottomColour' = Nothing,
-        leftStyle = None,
+        leftStyle = NoBorder,
         leftColour' = Nothing
       }
     inherit = const temp


@@ 65,13 65,13 @@ instance PropertyParser Border where
     longhand _ s "border-right-style" [t] | Just v<-style t=Just s {rightStyle=v}
     longhand _ s "border-bottom-style" [t]|Just v<-style t=Just s {bottomStyle=v}
     longhand _ s "border-left-style" [t] | Just v<-style t = Just s {leftStyle=v}
-    longhand _ self@Border { borderPallet = cc } "border-top-colour" ts
+    longhand _ self@Border { borderPallet = cc } "border-top-color" ts
         | Just ([], v) <- parseColour cc ts = Just self { topColour' = Just v }
-    longhand _ self@Border { borderPallet = cc } "border-right-colour" ts
+    longhand _ self@Border { borderPallet = cc } "border-right-color" ts
         | Just ([], v) <- parseColour cc ts = Just self { rightColour' = Just v }
-    longhand _ self@Border { borderPallet = cc } "border-bottom-colour" ts
+    longhand _ self@Border { borderPallet = cc } "border-bottom-color" ts
         | Just ([], v) <- parseColour cc ts = Just self { bottomColour' = Just v }
-    longhand _ self@Border { borderPallet = cc } "border-left-colour" ts
+    longhand _ self@Border { borderPallet = cc } "border-left-color" ts
         | Just ([], v) <- parseColour cc ts = Just self { bottomColour' = Just v }
 
     -- Should be handled by caller, but for the sake of shorthands...

@@ 106,6 106,7 @@ renderRectWith fragmentShader uniformNames = do
     uniformIDs <- forM uniformNames $ getUniformLocation prog
     matID <- getUniformLocation prog "transform"
     originID <- getUniformLocation prog "origin"
+    szID <- getUniformLocation prog "boxSize"
     glUseProgram prog
     glEnable GL_BLEND
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA


@@ 118,6 119,7 @@ renderRectWith fragmentShader uniformNames = do
         liftIO $ updateUniform prog matID $ mflip mat
         let r = origin' rects
         liftIO $ updateUniform prog originID $ V2 (left r) (top r)
+        liftIO $ updateUniform prog szID $ V2 (right r - left r) (bottom r - top r)
         _ <- forM (zip uniformIDs uniforms) $ \(slot, cb) -> cb prog slot
 
         withBoundTextures (map unTexture textures) $ do