{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
module Clay.Transform
(

-- * The transform propery.

  Transformation
, transform
, transforms
, TransformStyle
, transformStyle
, flat
, preserve3d
, TransformBox
, transformBox
, transformContentBox
, transformBorderBox
, fillBox
, strokeBox
, viewBox
, transformOrigin

-- * Translating.

, translate
, translateX, translateY, translateZ
, translate3d

-- * Scaling.

, scale
, scaleX, scaleY, scaleZ
, scale3d

-- * Rotating.

, rotate
, rotateX, rotateY, rotateZ
, rotate3d

-- * Skewing.

, skew
, skewX, skewY

-- * Custom 3D transformations.

, perspective
, matrix
, matrix3d 
)
where

import Prelude hiding (Left, Right)

import Clay.Property
import Clay.Stylesheet
import Clay.Size
import Clay.Common

newtype Transformation = Transformation Value
  deriving (Transformation -> Value
(Transformation -> Value) -> Val Transformation
forall a. (a -> Value) -> Val a
value :: Transformation -> Value
$cvalue :: Transformation -> Value
Val, Transformation
Transformation -> None Transformation
forall a. a -> None a
none :: Transformation
$cnone :: Transformation
None)

transform :: Transformation -> Css
transform :: Transformation -> Css
transform = Prefixed -> Transformation -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"transform")

transforms :: [Transformation] -> Css
transforms :: [Transformation] -> Css
transforms [Transformation]
xs = Prefixed -> Value -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"transform") ([Transformation] -> Value
forall a. Val a => [a] -> Value
noCommas [Transformation]
xs)

-------------------------------------------------------------------------------

newtype TransformStyle = TransformStyle Value
  deriving (TransformStyle -> Value
(TransformStyle -> Value) -> Val TransformStyle
forall a. (a -> Value) -> Val a
value :: TransformStyle -> Value
$cvalue :: TransformStyle -> Value
Val, TransformStyle
TransformStyle -> Inherit TransformStyle
forall a. a -> Inherit a
inherit :: TransformStyle
$cinherit :: TransformStyle
Inherit, TransformStyle
TransformStyle -> Initial TransformStyle
forall a. a -> Initial a
initial :: TransformStyle
$cinitial :: TransformStyle
Initial, TransformStyle
TransformStyle -> Unset TransformStyle
forall a. a -> Unset a
unset :: TransformStyle
$cunset :: TransformStyle
Unset)

transformStyle :: TransformStyle -> Css
transformStyle :: TransformStyle -> Css
transformStyle = Prefixed -> TransformStyle -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"transform-style")

flat, preserve3d :: TransformStyle
flat :: TransformStyle
flat = Value -> TransformStyle
TransformStyle Value
"flat"
preserve3d :: TransformStyle
preserve3d = Value -> TransformStyle
TransformStyle Value
"preserve-3d"

-------------------------------------------------------------------------------

newtype TransformBox = TransformBox Value
  deriving (TransformBox -> Value
(TransformBox -> Value) -> Val TransformBox
forall a. (a -> Value) -> Val a
value :: TransformBox -> Value
$cvalue :: TransformBox -> Value
Val, TransformBox
TransformBox -> Inherit TransformBox
forall a. a -> Inherit a
inherit :: TransformBox
$cinherit :: TransformBox
Inherit, TransformBox
TransformBox -> Initial TransformBox
forall a. a -> Initial a
initial :: TransformBox
$cinitial :: TransformBox
Initial, TransformBox
TransformBox -> Unset TransformBox
forall a. a -> Unset a
unset :: TransformBox
$cunset :: TransformBox
Unset)

transformBox :: TransformBox -> Css
transformBox :: TransformBox -> Css
transformBox = Prefixed -> TransformBox -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"transform-box")

transformContentBox, transformBorderBox, fillBox, strokeBox, viewBox :: TransformBox
transformContentBox :: TransformBox
transformContentBox = Value -> TransformBox
TransformBox Value
"contentBox"
transformBorderBox :: TransformBox
transformBorderBox = Value -> TransformBox
TransformBox Value
"borderBox"
fillBox :: TransformBox
fillBox = Value -> TransformBox
TransformBox Value
"fillBox"
strokeBox :: TransformBox
strokeBox = Value -> TransformBox
TransformBox Value
"strokeBox"
viewBox :: TransformBox
viewBox = Value -> TransformBox
TransformBox Value
"viewBox"

-------------------------------------------------------------------------------

transformOrigin :: [Size a] -> Css
transformOrigin :: [Size a] -> Css
transformOrigin = Prefixed -> Value -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"transform-origin") (Value -> Css) -> ([Size a] -> Value) -> [Size a] -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Size a] -> Value
forall a. Val a => [a] -> Value
noCommas

-------------------------------------------------------------------------------

scale :: Double -> Double -> Transformation
scale :: Double -> Double -> Transformation
scale Double
x Double
y = Value -> Transformation
Transformation (Value
"scale(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Double] -> Value
forall a. Val a => a -> Value
value [Double
x, Double
y] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

scaleX, scaleY, scaleZ :: Double -> Transformation

scaleX :: Double -> Transformation
scaleX Double
x = Value -> Transformation
Transformation (Value
"scaleX(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Double -> Value
forall a. Val a => a -> Value
value Double
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
scaleY :: Double -> Transformation
scaleY Double
y = Value -> Transformation
Transformation (Value
"scaleY(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Double -> Value
forall a. Val a => a -> Value
value Double
y Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
scaleZ :: Double -> Transformation
scaleZ Double
z = Value -> Transformation
Transformation (Value
"scaleZ(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Double -> Value
forall a. Val a => a -> Value
value Double
z Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

scale3d :: Double -> Double -> Double -> Transformation
scale3d :: Double -> Double -> Double -> Transformation
scale3d Double
x Double
y Double
z = Value -> Transformation
Transformation (Value
"scale3d(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Double] -> Value
forall a. Val a => a -> Value
value [Double
x, Double
y, Double
z] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

-------------------------------------------------------------------------------

rotate :: Angle a -> Transformation
rotate :: Angle a -> Transformation
rotate Angle a
x = Value -> Transformation
Transformation (Value
"rotate(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

rotateX, rotateY, rotateZ :: Angle a -> Transformation

rotateX :: Angle a -> Transformation
rotateX Angle a
x = Value -> Transformation
Transformation (Value
"rotateX(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
rotateY :: Angle a -> Transformation
rotateY Angle a
y = Value -> Transformation
Transformation (Value
"rotateY(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
y Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
rotateZ :: Angle a -> Transformation
rotateZ Angle a
z = Value -> Transformation
Transformation (Value
"rotateZ(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
z Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

rotate3d :: Double -> Double -> Double -> Angle a -> Transformation
rotate3d :: Double -> Double -> Double -> Angle a -> Transformation
rotate3d Double
x Double
y Double
z Angle a
a = Value -> Transformation
Transformation (Value
"rotate3d(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Value] -> Value
forall a. Val a => a -> Value
value [Double -> Value
forall a. Val a => a -> Value
value Double
x, Double -> Value
forall a. Val a => a -> Value
value Double
y, Double -> Value
forall a. Val a => a -> Value
value Double
z, Angle a -> Value
forall a. Val a => a -> Value
value Angle a
a] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

-------------------------------------------------------------------------------

translate :: Size a -> Size b -> Transformation
translate :: Size a -> Size b -> Transformation
translate Size a
x Size b
y = Value -> Transformation
Transformation (Value
"translate(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Value] -> Value
forall a. Val a => a -> Value
value [Size a -> Value
forall a. Val a => a -> Value
value Size a
x, Size b -> Value
forall a. Val a => a -> Value
value Size b
y] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

translateX, translateY :: Size LengthUnit -> Transformation
translateZ :: Size LengthUnit -> Transformation

translateX :: Size LengthUnit -> Transformation
translateX Size LengthUnit
x = Value -> Transformation
Transformation (Value
"translateX(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Size LengthUnit -> Value
forall a. Val a => a -> Value
value Size LengthUnit
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
translateY :: Size LengthUnit -> Transformation
translateY Size LengthUnit
y = Value -> Transformation
Transformation (Value
"translateY(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Size LengthUnit -> Value
forall a. Val a => a -> Value
value Size LengthUnit
y Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
translateZ :: Size LengthUnit -> Transformation
translateZ Size LengthUnit
z = Value -> Transformation
Transformation (Value
"translateZ(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Size LengthUnit -> Value
forall a. Val a => a -> Value
value Size LengthUnit
z Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

translate3d :: Size a -> Size b -> Size LengthUnit -> Transformation
translate3d :: Size a -> Size b -> Size LengthUnit -> Transformation
translate3d Size a
x Size b
y Size LengthUnit
z = Value -> Transformation
Transformation (Value
"translate3d(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Value] -> Value
forall a. Val a => a -> Value
value [Size a -> Value
forall a. Val a => a -> Value
value Size a
x, Size b -> Value
forall a. Val a => a -> Value
value Size b
y, Size LengthUnit -> Value
forall a. Val a => a -> Value
value Size LengthUnit
z] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

-------------------------------------------------------------------------------

skew :: Angle a -> Angle a -> Transformation
skew :: Angle a -> Angle a -> Transformation
skew Angle a
x Angle a
y = Value -> Transformation
Transformation (Value
"skew(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Angle a] -> Value
forall a. Val a => a -> Value
value [Angle a
x, Angle a
y] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

skewX, skewY :: Angle a -> Transformation

skewX :: Angle a -> Transformation
skewX Angle a
x = Value -> Transformation
Transformation (Value
"skewX(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")
skewY :: Angle a -> Transformation
skewY Angle a
y = Value -> Transformation
Transformation (Value
"skewY(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Angle a -> Value
forall a. Val a => a -> Value
value Angle a
y Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

-------------------------------------------------------------------------------

perspective :: Double -> Transformation
perspective :: Double -> Transformation
perspective Double
p = Value -> Transformation
Transformation (Value
"perspective(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Double -> Value
forall a. Val a => a -> Value
value Double
p Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

matrix :: Double -> Double -> Double -> Double -> Double -> Double -> Transformation
matrix :: Double
-> Double -> Double -> Double -> Double -> Double -> Transformation
matrix Double
u Double
v Double
w Double
x Double
y Double
z = Value -> Transformation
Transformation (Value
"matrix3d(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Double] -> Value
forall a. Val a => a -> Value
value [ Double
u, Double
v, Double
w, Double
x, Double
y, Double
z ] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

matrix3d :: Double -> Double -> Double -> Double
         -> Double -> Double -> Double -> Double
         -> Double -> Double -> Double -> Double
         -> Double -> Double -> Double -> Double
         -> Transformation
matrix3d :: Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Transformation
matrix3d Double
w0 Double
x0 Double
y0 Double
z0
         Double
w1 Double
x1 Double
y1 Double
z1
         Double
w2 Double
x2 Double
y2 Double
z2
         Double
w3 Double
x3 Double
y3 Double
z3 =
  Value -> Transformation
Transformation (Value
"matrix3d(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Double] -> Value
forall a. Val a => a -> Value
value
       [ Double
w0, Double
x0, Double
y0, Double
z0
       , Double
w1, Double
x1, Double
y1, Double
z1
       , Double
w2, Double
x2, Double
y2, Double
z2
       , Double
w3, Double
x3, Double
y3, Double
z3
       ] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")