3 files changed, 32 insertions(+), 12 deletions(-)

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

@@ 4,7 4,7 @@ module Graphics.Rendering.Rect.Backgrounds(Backgrounds(..), Pattern(..),
 
 import Graphics.Rendering.Rect.CSS.Backgrounds
 import Graphics.Rendering.Rect.Types
-import Graphics.Rendering.Rect.Image (Texture(texSize))
+import Graphics.Rendering.Rect.Image (Texture(texSize), textureSetRepeat)
 import qualified Data.ByteString.Char8 as B8
 import Linear (M44, V2(..))
 


@@ 177,12 177,13 @@ renderBackgrounds = do
                 `zip` (bgSize self ++ repeat (Size Auto Auto))
                 `zip` (origin self ++ repeat paddingBox)
                 `zip` (bgPos self ++ repeat (Absolute 0, Absolute 0))
-        _ <- forM layers $ \((((pat0, clip0), size0), origin0), pos0) -> case pat0 of
+                `zip` (bgRepeat self ++ repeat (True, True))
+        _ <- forM layers $ \(((((pat0, clip0), size0), origin0), pos0), repeat0) -> case pat0 of
             None -> return ()
-            Img img0 -> let sz = resolveSize (size $ clip0 a) (texSize img0) size0
-                in layer [img0] [
-                    u $ v2 $ sz, u $ v2 $ l2f' pos0 sz
-                ] clip0 origin0 a b
+            Img img0 -> do
+                let sz = resolveSize (size $ clip0 a) (texSize img0) size0
+                textureSetRepeat img0 repeat0
+                layer [img0] [u $ v2 sz, u $ v2 $ l2f' pos0 sz] clip0 origin0 a b
             Linear angle stops -> let size' = size $ clip0 a in linear [] [
                     u $ v2 $ size', u angle, cs 10 $ map fst stops,
                     us $ ls2fs size' $ map snd $ take 10 stops, u $ length stops

@@ 20,7 20,8 @@ data Backgrounds img = Backgrounds {
     origin :: [Rects -> Rect],
     image :: [Pattern img],
     bgPos :: [(Length, Length)],
-    bgSize :: [Resize]
+    bgSize :: [Resize],
+    bgRepeat :: [(Bool, Bool)]
 } deriving (Eq, Show, Read)
 
 type C = AlphaColour Float


@@ 41,7 42,7 @@ instance PropertyParser (Backgrounds Text) where
     temp = Backgrounds {
         pallet = temp, background = transparent, clip = [borderBox],
         image = [None], bgSize = [Size Auto Auto], origin = [paddingBox],
-        bgPos = [(Absolute 0, Absolute 0)]
+        bgPos = [(Absolute 0, Absolute 0)], bgRepeat = [(True, True)]
       }
     inherit _ = temp
     priority _ = []


@@ 162,6 163,18 @@ instance PropertyParser (Backgrounds Text) where
         Just self { origin = reverse val }
     longhand _ self "background-position" t | val@(_:_) <- parseCSSList position t,
         all (null . snd) val = Just self { bgPos = reverse $ map fst val }
+    longhand _ self "background-repeat" t | val@(_:_) <- parseCSSList inner t =
+        Just self { bgRepeat = reverse val }
+      where
+        inner [Ident "initial"] = Just (True, True)
+        inner [Ident "repeat-x"] = Just (True, False)
+        inner [Ident "repeat-y"] = Just (False, True)
+        inner [x] | Just y <- inner' x = Just (y, y)
+        inner [x, y] | Just x' <- inner' x, Just y' <- inner' y = Just (x', y')
+        inner _ = Nothing
+        inner' (Ident "repeat") = Just True
+        inner' (Ident "no-repeat") = Just False
+        inner' _ = Nothing
     longhand _ self "background-size" t | val@(_:_) <- parseCSSList inner t =
         Just self { bgSize = reverse val }
       where -- TODO: Add shorthand support, after background-position.


@@ 207,7 220,8 @@ box [Ident "initial"] = Just borderBox -- To aid shorthand implementation.
 box _ = Nothing
 
 position :: [Token] -> Maybe ((Length, Length), [Token])
-position (x:y:ts) = position' x y ts *> position' y x ts
+position (x:y:ts) = position' x y ts *> position' y x ts *> position' x x (y:ts)
+position (x:ts) = position' x x ts
 position _ = Nothing
 position' :: Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
 position' x y ts = case ((case x of

@@ 1,6 1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Graphics.Rendering.Rect.Image(
-    Atlas, buildAtlas, Texture(..), atlasLookup) where
+    Atlas, buildAtlas, Texture(..), atlasLookup, textureSetRepeat) where
 
 import qualified Data.HashMap.Lazy as HM
 import Data.Text (Text)


@@ 45,8 45,6 @@ buildAtlas cb srcs = do
                     0 format word . castPtr
         liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
         liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR
-        liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT
-        liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT
 
         return (toEnum $ dynamicMap imageWidth dyn',
                 toEnum $ dynamicMap imageHeight dyn')


@@ 59,6 57,13 @@ nilTexture :: Texture
 nilTexture = Texture 0 (0, 0)
 atlasLookup :: Text -> Atlas -> Texture
 atlasLookup key = fromMaybe nilTexture . HM.lookup key . unAtlas
+textureSetRepeat :: MonadIO m => Texture -> (Bool, Bool) -> m ()
+textureSetRepeat tex (repeatX, repeatY) = do
+    liftIO $ glBindTexture GL_TEXTURE_2D $ unTexture tex
+    liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $
+        if repeatX then GL_REPEAT else GL_CLAMP_TO_BORDER
+    liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $
+        if repeatY then GL_REPEAT else GL_CLAMP_TO_BORDER
 
 -- Convert pixels to some flavour of RGBA
 convertDyn :: DynamicImage -> DynamicImage