Hamburger icon.
Can be clicked to toggle between hamburger and cross. The hamburger must be called with an Int as id (`hamburger 0` e.g.), and a function `onHamburgerChecked :: Int -> Selector` gives the selector to use side effects.
This commit is contained in:
parent
6851bd1600
commit
f8d5cfc404
5 changed files with 66 additions and 3 deletions
|
@ -31,6 +31,7 @@ library
|
|||
Kit.Atoms.ButtonLink
|
||||
Kit.Atoms.Container
|
||||
Kit.Atoms.Fonts
|
||||
Kit.Atoms.Hamburger
|
||||
Kit.Atoms.Header
|
||||
Kit.Atoms.Image
|
||||
Kit.Atoms.Link
|
||||
|
|
55
src/Kit/Atoms/Hamburger.hs
Normal file
55
src/Kit/Atoms/Hamburger.hs
Normal file
|
@ -0,0 +1,55 @@
|
|||
module Kit.Atoms.Hamburger where
|
||||
|
||||
import Clay as C
|
||||
import Components
|
||||
import Data.Text ( pack )
|
||||
import Kit.Constants.Colors
|
||||
import Kit.Constants.Spacing as S
|
||||
import Text.Blaze.Html5 as H
|
||||
import Text.Blaze.Html5.Attributes as A
|
||||
import Utils.Clay
|
||||
|
||||
hamburger :: Int -> Component Html
|
||||
hamburger id = do
|
||||
addCss css
|
||||
return $ do
|
||||
H.input H.! A.type_ "checkbox" H.! A.id hamId
|
||||
H.label
|
||||
H.! class_ "hamburger"
|
||||
H.! A.for hamId
|
||||
H.! A.checked "false"
|
||||
$ mconcat
|
||||
$ (H.div H.!)
|
||||
. class_
|
||||
<$> ["top", "middle", "bottom"]
|
||||
<*> pure mempty
|
||||
where
|
||||
hamId = textValue hamId'
|
||||
hamId' = pack $ "hamburger" <> show id
|
||||
css = do
|
||||
C.input # byId hamId' ? do
|
||||
display none
|
||||
byClass "hamburger" & do
|
||||
C.width <> C.height $ huge
|
||||
display flex
|
||||
flexDirection column
|
||||
justifyContent spaceAround
|
||||
C.div ? do
|
||||
C.width (pct 100)
|
||||
backgroundColor $ primary @ 50
|
||||
paddingTop <> paddingBottom $ tiny
|
||||
uniform borderRadius (pct 30)
|
||||
transition "all" (sec 0.3) easeInOut (sec 0)
|
||||
byClass "top" & do
|
||||
transformOrigin [nil, nil]
|
||||
byClass "bottom" & do
|
||||
transformOrigin [nil, pct 100]
|
||||
onHamburgerChecked id |~ byClass' "hamburger" ? do
|
||||
C.div ? backgroundColor (secondary @ 50)
|
||||
byClass' "top" ? transform (rotate (deg 45))
|
||||
byClass' "bottom" ? transform (rotate (deg (-45)))
|
||||
byClass' "middle" ? transform (scaleY 0)
|
||||
|
||||
onHamburgerChecked :: Int -> Selector
|
||||
onHamburgerChecked id =
|
||||
C.input # byId (pack $ "hamburger" <> show id) # C.checked
|
|
@ -36,7 +36,7 @@ scale :: Double
|
|||
scale = 1.2
|
||||
|
||||
-- |Vertical spaces sizes
|
||||
tiny, small, regular, large, huge :: Size LengthUnit
|
||||
tiny, small, regular, large, huge, giant :: Size LengthUnit
|
||||
tiny = ex 0.25
|
||||
small = ex 0.5
|
||||
regular = ex 1
|
||||
|
|
|
@ -6,6 +6,7 @@ module Kit.Templates.Index
|
|||
import Components
|
||||
import Core.Render
|
||||
import Hakyll
|
||||
import Kit.Atoms.Hamburger
|
||||
import Kit.Atoms.Section
|
||||
import Kit.Molecules.Bricklayer
|
||||
import Kit.Molecules.Tag
|
||||
|
@ -29,7 +30,7 @@ indexBody :: Component Html
|
|||
indexBody =
|
||||
profileHeader
|
||||
<> (section' <.> bricklayer <*> mconcat
|
||||
[pure "$for(pages)$", blogCard dummy, pure "$endfor$"]
|
||||
[pure "$for(pages)$", blogCard dummy, pure "$endfor$", hamburger 0]
|
||||
)
|
||||
|
||||
indexCtx :: Tags -> [Item String] -> Context String
|
||||
|
|
|
@ -1,10 +1,16 @@
|
|||
module Utils.Clay
|
||||
( uniform
|
||||
, byClass'
|
||||
) where
|
||||
|
||||
import Clay
|
||||
import Clay.Selector
|
||||
import Control.Monad ( join )
|
||||
import Data.Text ( Text )
|
||||
|
||||
-- |Takes a function with signature a -> a -> a -> a -> b and makes it signature a -> b with the argument repeated 4 times.
|
||||
uniform :: (a -> a -> a -> a -> b) -> (a -> b)
|
||||
uniform = join . join . join
|
||||
|
||||
-- |Get a selector from byClass.
|
||||
byClass' :: Text -> Selector
|
||||
byClass' c = selectorFromText "" # byClass c
|
||||
|
|
Loading…
Reference in a new issue