From 82540dc39bfad0a18ba6157b6362ba40fc9dac9b Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sat, 1 Jul 2023 12:56:36 +1200
Subject: [PATCH] Fix background-position, code tidies.

---
 lib/Graphics/Rendering/Rect/Backgrounds.hs     | 6 ++++--
 lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs | 8 ++++----
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/lib/Graphics/Rendering/Rect/Backgrounds.hs b/lib/Graphics/Rendering/Rect/Backgrounds.hs
index 7770c68..09a2698 100644
--- a/lib/Graphics/Rendering/Rect/Backgrounds.hs
+++ b/lib/Graphics/Rendering/Rect/Backgrounds.hs
@@ -178,12 +178,14 @@ renderBackgrounds = do
                 `zip` (origin self ++ repeat paddingBox)
                 `zip` (bgPos self ++ repeat (Absolute 0, Absolute 0))
                 `zip` (bgRepeat self ++ repeat (True, True))
-        _ <- forM layers $ \(((((pat0, clip0), size0), origin0), pos0), repeat0) -> case pat0 of
+        _<-forM layers $ \(((((pat0, clip0), size0), origin0), pos0), repeat0) ->
+          case pat0 of
             None -> return ()
             Img img0 -> do
                 let sz = resolveSize (size $ clip0 a) (texSize img0) size0
+                let pos' = (v2$l2f' pos0$size$clip0 a) - (v2$l2f' pos0 sz)
                 textureSetRepeat img0 repeat0
-                layer [img0] [u $ v2 sz, u $ v2 $ l2f' pos0 sz] clip0 origin0 a b
+                layer [img0] [u $ v2 sz, u pos'] 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
diff --git a/lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs b/lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs
index ee04773..1f1a725 100644
--- a/lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs
+++ b/lib/Graphics/Rendering/Rect/CSS/Backgrounds.hs
@@ -220,8 +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 x (y:ts)
-position (x:ts) = position' x x ts
+position (x:y:ts) = position' x y ts <* position' y x ts <* position' x x (y:ts)
+position [x] = position' x x []
 position _ = Nothing
 position' :: Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
 position' x y ts = case ((case x of
@@ -234,7 +234,7 @@ position' x y ts = case ((case x of
     case y of
         Ident "top" -> Scale 0
         Ident "center" -> Scale 0.5
-        Ident "right" -> Scale 1
+        Ident "bottom" -> Scale 1
         Percentage _ a -> p' a
         Dimension _ a "px" -> f' a
         _ -> Auto),
@@ -264,7 +264,7 @@ colourStops _ _ = Nothing
 parseCSSList :: ([Token] -> Maybe a) -> [Token] -> [a]
 parseCSSList cb toks | all isJust ret = catMaybes ret
     | otherwise = []
-  where ret = map cb $ concat $ splitList [Comma] $ parseOperands toks
+  where ret = map cb $ map concat $ splitList [Comma] $ parseOperands toks
 
 f :: NumericValue -> Float
 f (NVInteger x) = fromInteger x
-- 
2.30.2