3 files changed, 33 insertions(+), 8 deletions(-)

M lib/Graphics/Rendering/Rect.hs
M lib/Graphics/Rendering/Rect/Backgrounds.hs
M lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs

@@ 35,7 35,7 @@ styleResolveImages atlas self =
   where
     atlasLookup' None = None
     atlasLookup' (Img path) = Img $ atlasLookup path atlas
-    atlasLookup' (Linear a b) = Linear a b
+    atlasLookup' (Linear a b c) = Linear a b c
 
 atlasFromStyles :: MonadIO m =>
         (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas

@@ 34,7 34,14 @@ linearFragmentShader = B8.pack $ unlines [
     "uniform vec2 size;",
     "uniform vec4 start;",
     "uniform vec4 end;",
-    "void main() { fcolour = mix(start, end, coord.y/size.y); }"
+    "uniform float angle;",
+    "void main() {",
+    "   vec2 pos = coord/size;", -- Range 0..1
+    "   pos -= 0.5; pos *= 2;", -- Range -1..1
+    "   float a = pos.x*sin(angle) + pos.y*-cos(angle);", -- Range -1..1
+    "   a /= 2; a += 0.5;", -- Range 0..1
+    "   fcolour = mix(start, end, a);",
+    "}"
   ]
 
 renderBackgrounds :: (MonadIO m, MonadIO n) =>


@@ 42,7 49,7 @@ renderBackgrounds :: (MonadIO m, MonadIO n) =>
 renderBackgrounds = do
     base <- renderRectWith baseFragmentShader ["colour"]
     layer <- renderRectWith imageFragmentShader ["size"]
-    linear <- renderRectWith linearFragmentShader ["size", "start", "end"]
+    linear <- renderRectWith linearFragmentShader ["size", "start", "end", "angle"]
     return $ \self a b -> do
         base [] [c $ background self] (headDef borderBox $ clip self) a b
         let layers = image self `zip` (clip self ++ repeat borderBox)


@@ 52,8 59,8 @@ renderBackgrounds = do
             Img img0 -> layer [img0] [
                     u $ v2 $ resolveSize (size $ clip0 a) (texSize img0) size0
                 ] clip0 a b
-            Linear start end -> linear [] [
-                    u $ v2 $ size $ clip0 a, c start, c end
+            Linear angle start end -> linear [] [
+                    u $ v2 $ size $ clip0 a, c start, c end, u angle
                 ] clip0 a b
         return ()
 

@@ 24,7 24,7 @@ data Backgrounds img = Backgrounds {
 
 type C = AlphaColour Float
 
-data Pattern img = None | Img img | Linear C C deriving (Eq, Show, Read)
+data Pattern img = None | Img img | Linear Float C C deriving (Eq, Show, Read)
 
 -- We need to resolve images before we can compute the actual lengths!
 data Resize = Cover | Contain | Size Length Length deriving (Eq, Show, Read)


@@ 56,8 56,26 @@ instance PropertyParser (Backgrounds Text) where
         inner [Url ret] = Just $ Img ret
         inner [Function "url", String ret, RightParen] = Just $ Img ret
         inner (Function "linear-gradient":toks)
-            | Just [s, e] <- colourStops (Comma:toks) = Just $ Linear s e
-            | otherwise = traceShow toks Nothing
+            | Just [s, e] <- colourStops (Comma:toks) = Just $ Linear pi s e
+        inner (Function "linear-gradient":Dimension _ x unit:toks)
+            | Just rad <- lookup unit [("deg", pi/180), ("grad", pi/200),
+                    ("rad", 1), ("turn", 2*pi)],
+                Just [s, e] <- colourStops toks = Just $ Linear (f x*rad) s e
+        inner (Function "linear-gradient":Ident "to":Ident a:Ident b:toks)
+            | Just angle <- corner a b, Just [s, e] <- colourStops toks =
+                Just $ Linear angle s e
+            | Just angle <- corner b a, Just [s, e] <- colourStops toks =
+                Just $ Linear angle s e
+          where
+            corner "top" "right" = Just $ 0.25*pi
+            corner "bottom" "right" = Just $ 0.75*pi
+            corner "bottom" "left" = Just $ 1.25*pi
+            corner "top" "left" = Just $ 1.75*pi
+            corner _ _ = Nothing
+        inner (Function "linear-gradient":Ident "to":Ident side:toks)
+            | Just angle <- lookup side [
+                ("top", 0), ("right", pi/2), ("bottom", pi), ("left", pi*1.5)],
+                Just [s, e] <- colourStops toks = Just $ Linear angle s e
         inner _ = Nothing
         colourStops [RightParen] = Just []
         colourStops (Comma:toks)