module SimpleCss.Tricks.Images
    (BkgIm(..), bkgIm, bkgIms, gallery)
where


import Data.List

import Language.Css.Syntax
import Language.Css.Build
import qualified Language.Css.Build.Idents as C

import SimpleCss

cb = C.clear <:> C.both
fl = C.float <:> C.left
fr = C.float <:> C.right

-- | representing background images
data BkgIm = BkgIm 
            { bkgImUrl :: String
            , bkgImRepeat :: Expr
            , bkgImXPos :: Expr
            , bkgImYPos :: Expr                
            }
-- | synonym to 'BkgIm'
--
-- arguments are
--
-- * url
--
-- * repeat property
--
-- * x coordinate
--
-- * y coordinate
bkgIm :: String -> Expr -> Expr -> Expr -> BkgIm
bkgIm = BkgIm

-- | set of background images
--
-- arguments
--
-- * background color
--
-- * list of images
--
-- head of list is on top, then goes second image and etc.
bkgIms :: Expr -> [BkgIm] -> Css a -> Css a
bkgIms col ims = colSt . foldl1 (.) styles
    where styles = map ((\x -> dot x . div')  . fromBkgIm) $ reverse ims
          colSt  = dot [C.backgroundColor <:> col] . div'


fromBkgIm :: BkgIm -> [Decl]
fromBkgIm x = [
    C.background <:> 
        spaces [url $ bkgImUrl x, bkgImRepeat x, bkgImXPos x, bkgImYPos x],
    C.margin <:> int 0,
    C.padding <:> int 0,
    C.display <:> C.table,
    C.width <:> pct 100]

-- | floating gallery of images
gallery :: [Css a] -> Css a
gallery = vcat . (: [dot [cb] $ vcat []]) . vcat . map (dot [fl])