381 lines
9.4 KiB
Haskell
381 lines
9.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
import Clay hiding (div)
|
|
import Clay.Stylesheet
|
|
import Data.Monoid ((<>))
|
|
import Data.Text (pack)
|
|
import Prelude hiding ((**))
|
|
|
|
import qualified Data.List as L
|
|
|
|
data CalcSize = Px Integer
|
|
| Pt Double
|
|
| Em Double
|
|
| Rem Double
|
|
| Ex Double
|
|
| Zero
|
|
deriving (Eq, Ord)
|
|
|
|
instance Num CalcSize where
|
|
fromInteger i | j == 0 = Zero
|
|
| j < 0 = Zero
|
|
| otherwise = Px j
|
|
where j = fromIntegral i
|
|
|
|
Zero + b = b
|
|
a + Zero = a
|
|
Px a + Px b = Px $ a + b
|
|
Pt a + Pt b = Pt $ a + b
|
|
Em a + Em b = Em $ a + b
|
|
Rem a + Rem b = Rem $ a + b
|
|
Ex a + Ex b = Ex $ a + b
|
|
_ + _ = error "Can't add sizes of different kinds"
|
|
|
|
Zero * b = b
|
|
a * Zero = a
|
|
Px a * Px b = Px $ a * b
|
|
Pt a * Pt b = Pt $ a * b
|
|
Em a * Em b = Em $ a * b
|
|
Rem a * Rem b = Rem $ a * b
|
|
Ex a * Ex b = Ex $ a * b
|
|
_ * _ = error "Can't multiply sizes of different kinds"
|
|
|
|
abs Zero = Zero
|
|
abs (Px i) = Px $ abs i
|
|
abs (Pt d) = Pt $ abs d
|
|
abs (Em d) = Em $ abs d
|
|
abs (Rem d) = Rem $ abs d
|
|
abs (Ex d) = Ex $ abs d
|
|
|
|
signum Zero = Zero
|
|
signum (Px i) = Px $ signum i
|
|
signum (Pt d) = Pt $ signum d
|
|
signum (Em d) = Em $ signum d
|
|
signum (Rem d) = Rem $ signum d
|
|
signum (Ex d) = Ex $ signum d
|
|
|
|
times :: Integer -> CalcSize -> CalcSize
|
|
i `times` Zero = Zero
|
|
i `times` Px b = Px $ i * b
|
|
i `times` Pt b = Pt $ (fromIntegral i) * b
|
|
i `times` Em b = Em $ (fromIntegral i) * b
|
|
i `times` Rem b = Rem $ (fromIntegral i) * b
|
|
i `times` Ex b = Ex $ (fromIntegral i) * b
|
|
|
|
toSize :: CalcSize -> Size LengthUnit
|
|
toSize s = case s of
|
|
Zero -> nil
|
|
Px i -> px $ fromIntegral i
|
|
Pt d -> pt d
|
|
Em d -> em d
|
|
Rem d -> em d -- todo: Add rem to Clay.Size
|
|
Ex d -> ex d
|
|
|
|
perct :: CalcSize -> CalcSize -> Double
|
|
perct Zero b = 0
|
|
perct a Zero = error "Division by zero"
|
|
perct (Px a) (Px b) = (fromIntegral a) / (fromIntegral b) * 100
|
|
perct (Pt a) (Pt b) = a / b * 100
|
|
perct (Em a) (Em b) = a / b * 100
|
|
perct (Rem a) (Rem b) = a / b * 100
|
|
perct (Ex a) (Ex b) = a / b * 100
|
|
perct _ _ = error "Can't take percentage of different kinds"
|
|
|
|
percentage :: CalcSize -> CalcSize -> Size Percentage
|
|
percentage a b = pct $ perct a b
|
|
|
|
data LayoutSettings =
|
|
Layout { totalColumns :: Integer
|
|
, columnWidth :: CalcSize
|
|
, gutterWidth :: CalcSize
|
|
, gridPadding :: CalcSize
|
|
}
|
|
|
|
data ColSpec = Full
|
|
| Next Integer Integer
|
|
| Final Integer Integer
|
|
|
|
columnsWidth cols =
|
|
let gutter = gutterWidth def
|
|
colWidth = columnWidth def
|
|
baseWidth = cols `times` colWidth
|
|
in
|
|
if cols >= 1
|
|
then baseWidth + ((cols - 1) `times` gutter)
|
|
else baseWidth
|
|
|
|
relativeWidth width ctx =
|
|
percentage width (columnsWidth ctx)
|
|
|
|
widthWithGridPadding cols =
|
|
let width = columnsWidth cols
|
|
basePad = gridPadding def
|
|
in width + (2 `times` basePad)
|
|
|
|
container =
|
|
let pad = gridPadding def
|
|
width = widthWithGridPadding $ totalColumns def
|
|
in do
|
|
maxWidth $ toSize width
|
|
paddingLeft $ toSize pad
|
|
paddingRight $ toSize pad
|
|
marginLeft auto
|
|
marginRight auto
|
|
|
|
colSpan spec = case spec of
|
|
Full -> do
|
|
clear both
|
|
Next n m ->
|
|
let gutter = gutterWidth def
|
|
colsWidth = columnsWidth n
|
|
rw = relativeWidth colsWidth m
|
|
rm = percentage gutter (columnsWidth m)
|
|
in do
|
|
width rw
|
|
float floatLeft
|
|
marginRight rm
|
|
Final n m ->
|
|
let colsWidth = columnsWidth n
|
|
rw = relativeWidth colsWidth m
|
|
in do
|
|
width rw
|
|
float floatRight
|
|
marginRight nil
|
|
|
|
push spec = case spec of
|
|
Next n m ->
|
|
let gutter = gutterWidth def
|
|
colsWidth = columnsWidth n
|
|
rw = relativeWidth colsWidth m
|
|
in do
|
|
marginLeft rw
|
|
_ -> error "Bad push spec"
|
|
|
|
pull spec = case spec of
|
|
Next n m ->
|
|
let gutter = gutterWidth def
|
|
colsWidth = columnsWidth n
|
|
rw = relativeWidth colsWidth m
|
|
in do
|
|
marginLeft (0 - rw)
|
|
_ -> error "Bad pull spec"
|
|
|
|
|
|
data GridShow = Pad | Col | Gut
|
|
showGrid =
|
|
let begin = "-moz-linear-gradient(left center, "
|
|
gutColor = " transparent "
|
|
padColor = " transparent "
|
|
colColor = " rgba(255, 254, 251, 0.5) "
|
|
totalWidth = widthWithGridPadding $ totalColumns def
|
|
padWidth = perct (gridPadding def) totalWidth
|
|
colWidth = perct (columnWidth def) totalWidth
|
|
gutWidth = perct (gutterWidth def) totalWidth
|
|
colCount = fromIntegral (totalColumns def)
|
|
cols = Pad : L.intersperse Gut (replicate colCount Col)
|
|
go xs out s = case xs of
|
|
[] -> begin ++ out ++ padColor ++ (show s) ++ "%, " ++ padColor ++ "100%)"
|
|
Pad:xs ->
|
|
let n = padWidth + s
|
|
v = padColor ++ (show s) ++ "%, " ++ padColor ++ (show n) ++ "% ,"
|
|
in go xs (out ++ v) n
|
|
Col:xs ->
|
|
let n = colWidth + s
|
|
v = colColor ++ (show s) ++ "%, " ++ colColor ++ (show n) ++ "% ,"
|
|
in go xs (out ++ v) n
|
|
Gut:xs ->
|
|
let n = gutWidth + s
|
|
v = gutColor ++ (show s) ++ "%, " ++ gutColor ++ (show n) ++ "% ,"
|
|
in go xs (out ++ v) n
|
|
in pack $ go cols "" 0
|
|
|
|
showBaseline n = do
|
|
backgroundSize $ (px 40) `by` (px n)
|
|
backgroundImage $ repeatingLinearGradient (angular $ deg 0) [("#111", pct 0)
|
|
,("#111", pct 1)
|
|
,(transparent, pct 1)
|
|
,(transparent, pct n)]
|
|
height (pct 100)
|
|
width (pct 100)
|
|
opacity 0.75
|
|
position absolute
|
|
top nil
|
|
left nil
|
|
zIndex (-4)
|
|
|
|
|
|
defaultFontPx = 16
|
|
|
|
pxRatio x y = (fromIntegral x) / (fromIntegral y)
|
|
emFromRatio elemPx fontPx = em $ pxRatio elemPx fontPx
|
|
|
|
selectors :: [Selector] -> Selector
|
|
selectors = foldl1 (<>)
|
|
|
|
setFontSize x = do
|
|
let line = 1 + x / baselinePx
|
|
fontSize $ em $ x / defaultFontPx
|
|
lineHeight $ em $ (line * baselinePx) / x
|
|
|
|
{- Insert this into main for layout-debugging grids
|
|
|
|
body ? (showBaseline baselinePx)
|
|
"#container" ? do
|
|
container
|
|
backgroundColor "#EEE8D5"
|
|
"background-image" -: showGrid
|
|
|
|
-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- Syntax Highlighting via highlighting-kate
|
|
scKeyword, scDataType, scDecimal, scBaseN, scFloat, scChar, scString :: Selector
|
|
scComment, scOther, scAlert, scFunction, scRegion, scError :: Selector
|
|
|
|
scKeyword = ".kw"
|
|
scDataType = ".dt"
|
|
scDecimal = ".dv"
|
|
scBaseN = ".bn"
|
|
scFloat = ".fl"
|
|
scChar = ".ch"
|
|
scString = ".st"
|
|
scComment = ".co"
|
|
scOther = ".ot"
|
|
scAlert = ".al"
|
|
scFunction = ".fu"
|
|
scRegion = ".re"
|
|
scError = ".er"
|
|
|
|
syntaxHighlight = pre # ".sourceCode" ? do
|
|
backgroundColor "#F9F9F9"
|
|
borderLeft solid (px 3) accent2
|
|
scKeyword <> scDataType ? color "#268BD2"
|
|
scDecimal <> scBaseN <> scFloat ? color "#D33682"
|
|
scChar ? color "#DC322F"
|
|
scString ? color "#2AA198"
|
|
scComment ? color "#93A1A1"
|
|
scOther ? color "#A57800"
|
|
scFunction ? color "#268BD2"
|
|
scError ? do color "#D30102"
|
|
fontWeight bold
|
|
scAlert ? do color "#CB4B16"
|
|
fontWeight bold
|
|
|
|
-----------------------------------------------------------------------------
|
|
|
|
def =
|
|
Layout { totalColumns = 12
|
|
, columnWidth = Em 3
|
|
, gutterWidth = Em 1
|
|
, gridPadding = Em 1
|
|
}
|
|
|
|
primary = "#033E6B"
|
|
accent1 = "#FFB400"
|
|
accent2 = "#A63F00"
|
|
|
|
bodyCopyColor = "#444"
|
|
|
|
baselinePx = 24
|
|
baseFontPx = 16
|
|
headingColor = primary
|
|
|
|
main = putCss $ do
|
|
typography
|
|
syntaxHighlight
|
|
|
|
"#container" ? do
|
|
container
|
|
|
|
"#header" ? do
|
|
push $ Next 1 12
|
|
colSpan $ Next 11 12
|
|
|
|
"#navigation" ? (colSpan $ Final 2 12)
|
|
|
|
"#content" ? do
|
|
push $ Next 1 12
|
|
colSpan $ Next 9 12
|
|
|
|
"#footer" ? do
|
|
push $ Next 1 12
|
|
colSpan $ Next 11 12
|
|
|
|
typography = do
|
|
-- Reset the padding/margin on all elements so we can set up a vertical
|
|
-- rhythm on a baseline grid
|
|
star ? do
|
|
sym margin nil
|
|
sym padding nil
|
|
|
|
body ? do
|
|
fontFamily ["PT Sans", "Verdana"] [sansSerif]
|
|
textRendering optimizeLegibility
|
|
color bodyCopyColor
|
|
a ? color primary
|
|
lineHeight $ em $ baselinePx / defaultFontPx
|
|
|
|
"#logo" ? do
|
|
paddingTop $ px (1*baselinePx)
|
|
a ? do
|
|
setFontSize 75
|
|
fontFamily ["Orbitron"] [sansSerif]
|
|
fontWeight (other "700")
|
|
textDecoration none
|
|
color headingColor
|
|
|
|
ul |> li ? do
|
|
paddingLeft $ em (-0.7)
|
|
textIndent $ indent (em (-0.7))
|
|
":before" & do
|
|
content $ stringContent "- "
|
|
color accent2
|
|
a ? do
|
|
textDecoration none
|
|
|
|
"#navigation" ** li ? do
|
|
setFontSize 24
|
|
fontFamily ["Oswald"] [sansSerif]
|
|
fontWeight (other "400")
|
|
|
|
".info" ? do
|
|
color accent2
|
|
|
|
"#footer" ** p ? do
|
|
color accent2
|
|
|
|
selectors [ p, ".info", "#logo", pre ] ? do
|
|
setFontSize baseFontPx
|
|
marginBottom $ px baselinePx
|
|
|
|
selectors [ h1, h2, h3] ? do
|
|
fontFamily ["Oswald"] [sansSerif]
|
|
fontWeight (other "400")
|
|
color headingColor
|
|
|
|
h1 ? do
|
|
setFontSize 42
|
|
let btw = 3
|
|
ptw = 6
|
|
paddingTop $ px ptw
|
|
borderTop solid (px btw) accent1
|
|
marginBottom $ px (baselinePx - btw - ptw)
|
|
|
|
h2 ? do
|
|
setFontSize 32
|
|
marginBottom $ px baselinePx
|
|
|
|
h3 ? do
|
|
setFontSize 24
|
|
|
|
ul <> ol ? do
|
|
marginLeft $ em $ baselinePx / baseFontPx
|
|
marginBottom $ px baselinePx
|
|
"list-style-type" -: "none"
|
|
|
|
blockquote ? do
|
|
backgroundColor "#F9F9F9"
|
|
borderLeft solid (px 3) accent1
|
|
paddingLeft (em 1)
|
|
|
|
|