0 | module Text.CSS.Gradient
  1 |
  2 | import Data.List
  3 | import Data.Nat
  4 | import Data.String
  5 | import Text.CSS.Angle
  6 | import Text.CSS.Color
  7 | import Text.CSS.Length
  8 | import Text.CSS.Percentage
  9 |
 10 | %default total
 11 |
 12 | --------------------------------------------------------------------------------
 13 | --          Side or Corner
 14 | --------------------------------------------------------------------------------
 15 |
 16 | public export
 17 | data SideOrCorner : Type where
 18 |   Left        : SideOrCorner
 19 |   Right       : SideOrCorner
 20 |   Top         : SideOrCorner
 21 |   Bottom      : SideOrCorner
 22 |   TopLeft     : SideOrCorner
 23 |   TopRight    : SideOrCorner
 24 |   BottomLeft  : SideOrCorner
 25 |   BottomRight : SideOrCorner
 26 |
 27 | export
 28 | Interpolation SideOrCorner where
 29 |   interpolate Left        = "left"
 30 |   interpolate Right       = "right"
 31 |   interpolate Top         = "top"
 32 |   interpolate Bottom      = "bottom"
 33 |   interpolate TopLeft     = "top left"
 34 |   interpolate TopRight    = "top right"
 35 |   interpolate BottomLeft  = "bottom left"
 36 |   interpolate BottomRight = "bottom right"
 37 |
 38 | --------------------------------------------------------------------------------
 39 | --          Linear Direction
 40 | --------------------------------------------------------------------------------
 41 |
 42 | public export
 43 | data LinearDirection : Type where
 44 |   Deflt : LinearDirection
 45 |   Angle : Angle -> LinearDirection
 46 |   To    : SideOrCorner -> LinearDirection
 47 |
 48 | public export %inline
 49 | Cast Angle LinearDirection where
 50 |   cast = Angle
 51 |
 52 | export
 53 | Interpolation LinearDirection where
 54 |   interpolate Deflt     = ""
 55 |   interpolate (Angle x) = "\{x}"
 56 |   interpolate (To x)    = "to \{x}"
 57 |
 58 | --------------------------------------------------------------------------------
 59 | --          Length or Percentage
 60 | --------------------------------------------------------------------------------
 61 |
 62 | public export
 63 | data LengthOrPercentage : Type where
 64 |   L : Length -> LengthOrPercentage
 65 |   P : Percentage -> LengthOrPercentage
 66 |
 67 | export %inline
 68 | Cast Length LengthOrPercentage where cast = L
 69 |
 70 | export %inline
 71 | Cast Percentage LengthOrPercentage where cast = P
 72 |
 73 | export
 74 | Interpolation LengthOrPercentage where
 75 |   interpolate (L x) = interpolate x
 76 |   interpolate (P x) = interpolate x
 77 |
 78 | --------------------------------------------------------------------------------
 79 | --          Color Stop List
 80 | --------------------------------------------------------------------------------
 81 |
 82 | public export
 83 | data CSLState = Empty | Stop | Hint
 84 |
 85 | public export
 86 | data ColorStopListElem : (st : CSLState) -> Type where
 87 |   C :
 88 |        Color
 89 |     -> (ps : List LengthOrPercentage)
 90 |     -> {auto 0 prf : LTE (length ps) 2}
 91 |     -> ColorStopListElem Stop
 92 |   H : LengthOrPercentage -> ColorStopListElem Hint
 93 |
 94 | export %inline
 95 | col : Color -> ColorStopListElem Stop
 96 | col c = C c []
 97 |
 98 | export
 99 | Interpolation (ColorStopListElem st) where
100 |   interpolate (C c ps)  = unwords $ interpolate c :: map interpolate ps
101 |   interpolate (H x)     = "\{x}"
102 |
103 | public export
104 | data Match : CSLState -> CSLState -> Type where
105 |   MatchStop : Match Stop s
106 |   MatchHint : Match Hint Stop
107 |
108 | public export
109 | data ColorStopList : (st : CSLState) -> Type where
110 |   Nil  : ColorStopList Empty
111 |   (::) :
112 |        (h : ColorStopListElem sh)
113 |     -> (t : ColorStopList st)
114 |     -> {auto 0 prf : Match sh st}
115 |     -> ColorStopList sh
116 |
117 | export
118 | Interpolation (ColorStopList st) where
119 |   interpolate [v]    = "\{v}"
120 |   interpolate (h::t) = "\{h}, \{t}"
121 |   interpolate []     = ""
122 |
123 | --------------------------------------------------------------------------------
124 | --          Gradient
125 | --------------------------------------------------------------------------------
126 |
127 | public export
128 | data Gradient : Type where
129 |   Linear :
130 |        (dir    : LinearDirection)
131 |     -> (colors : ColorStopList Stop)
132 |     -> Gradient
133 |
134 | export
135 | Interpolation Gradient where
136 |   interpolate (Linear Deflt cs) = "linear-gradient(\{cs})"
137 |   interpolate (Linear x cs)     = "linear-gradient(\{x}, \{cs})"
138 |