module SimpleCss.Tricks.Menus
    (hmenu, hmenuRel, vmenu, tabs)
where


import Data.List

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

import SimpleCss

import SimpleCss.Tricks.Shortcuts.Css

---------------------------------------------------------
-- style short-cuts

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

posr = C.position <:> C.relative
posa = C.position <:> C.absolute

l n = C.left  <:> n
r n = C.right <:> n
w n = C.width <:> n
h n = C.height <:> n


mt n = C.marginTop <:> n
mb n = C.marginBottom <:> n
ml n = C.marginLeft <:> n
mr n = C.marginRight <:> n

pl n = C.paddingLeft <:> n
pr n = C.paddingRight <:> n

oh  = C.overflow <:> C.hidden

dspIB = C.display <:> C.inlineBlock
dspB  = C.display <:> C.block
dspI  = C.display <:> C.inline
dspN  = C.display <:> C.none

-- | making tabs
--
-- arguments
--
-- * menu constructor
--
-- * active style
--
-- * passive style
--
-- * elements
--
-- result
--
-- * list of menus' with different active tabs

tabs :: ([Css a] -> Css a) -> [Box] -> [Box] -> [Css a] -> [Css a]
tabs menu actives passives elems = 
    [ menu $ zipWith ($) (st i) elems' | i <- [0 .. n]]
    where stA  = map static actives'
          stP  = zipWith rollOver passives' actives'
          n    = length elems' - 1
          st i = take i stP ++ (stA !! i : drop (i + 1) stP)
          (actives', passives', elems') = unzip3 $ zip3 actives passives elems




-- | vertical menu
vmenu :: [Css a] -> Css a
vmenu = vcat . zipWith ($) (map (. div') styles)
    where styles = map dot $ repeat [dspB] 

    
-- | horizontal menu
hmenu :: [Css a] -> Css a
hmenu xs = vcat $ zipWith ($) (map (. div') styles) xs
    where styles = map dot $ repeat [dspIB]
    
-- | relative horizontal menu, everything is forced to equal width 
hmenuRel :: [Css a] -> Css a
hmenuRel xs = vcat $ zipWith ($) (map (. div') styles) xs
    where styles = map dot $ repeat [dspIB, w $ pct (100 / n)]
          n = fromInteger $ toInteger $ length xs