
   0 | module Text.SVG.Attribute
   1 | 
   2 | import Data.String
   3 | import Text.SVG.Tag
   4 | import Text.SVG.Types
   5 | 
   6 | %default total
   7 | 
   8 | ||| SVG Attributes, indexed by the SVG element's name.
   9 | |||
  10 | ||| Implementation note: Numeric attributes get their own constructors.
  11 | ||| This allows us to more efficiently set such attributes programmatically
  12 | ||| at the DOM, avoiding unnecessary conversions to `String` and back.
  13 | public export
  14 | data SVGAttribute : (s : String) -> Type where
  15 |   Id     : {0 s : _} -> String -> SVGAttribute s
  16 |   Str    : {0 s : _} -> (name,val : String) -> SVGAttribute s
  17 |   Style  : {0 s : _} -> (name,val : String) -> SVGAttribute s
  18 |   Bool   : {0 s : _} -> (name : String) -> Bool -> SVGAttribute s
  19 |   LOP    : {0 s : _} -> (name : String) -> LengthOrPercentage -> SVGAttribute s
  20 |   Perc   : {0 s : _} -> (name : String) -> Percentage -> SVGAttribute s
  21 |   Pth    : {0 s : _} -> (name : String) -> List PathCmd -> SVGAttribute s
  22 |   Points : {0 s : _} -> (name : String) -> List Double -> SVGAttribute s
  23 |   Empty  : {0 s : _} -> SVGAttribute s
  24 | 
  25 | opac : String -> Percentage -> String
  26 | opac s p = #"\#{s}-opacity="\#{p}""#
  27 | 
  28 | displayAttribute : {0 s : _} -> SVGAttribute s -> String
  29 | displayAttribute (Id va)        = #"id="\#{va}""#
  30 | displayAttribute (Str nm va)    = #"\#{nm}="\#{va}""#
  31 | displayAttribute (LOP nm va)    = #"\#{nm}="\#{va}""#
  32 | displayAttribute (Perc nm va)   = #"\#{nm}="\#{va}""#
  33 | displayAttribute (Pth nm va)    = #"\#{nm}="\#{unwords $ map interpolate va}""#
  34 | displayAttribute (Points nm va) = #"\#{nm}="\#{unwords $ map renderDouble va}""#
  35 | displayAttribute (Bool nm True) = nm
  36 | displayAttribute (Bool _ False) = ""
  37 | displayAttribute Empty          = ""
  38 | displayAttribute (Style nm va)  = "\{nm}:\{va};"
  39 | 
  40 | export
  41 | displayAttributes : {0 s : _} -> List (SVGAttribute s) -> String
  42 | displayAttributes = go [<] [<]
  43 |   where
  44 |     go : SnocList String -> SnocList String -> List (SVGAttribute f) -> String
  45 |     go [<] attrs    [] = unwords (attrs <>> [])
  46 |     go styles attrs [] =
  47 |       unwords (attrs <>> [fastConcat $ "style=\"" :: (styles <>> ["\""])])
  48 |     go styles attrs (x::xs) =
  49 |       case x of
  50 |         Style n v => go (styles :< "\{n}:\{v};") attrs xs
  51 |         _         => go styles (attrs :< displayAttribute x) xs
  52 | 
  53 | --------------------------------------------------------------------------------
  54 | -- Predefine Attributes
  55 | --------------------------------------------------------------------------------
  56 | 
  57 | export %inline
  58 | d : List PathCmd -> SVGAttribute "path"
  59 | d = Pth "d"
  60 | 
  61 | export %inline
  62 | r : LengthOrPercentage -> SVGAttribute "circle"
  63 | r = LOP "r"
  64 | 
  65 | export %inline
  66 | x1 : LengthOrPercentage -> SVGAttribute "line"
  67 | x1 = LOP "x1"
  68 | 
  69 | export %inline
  70 | y1 : LengthOrPercentage -> SVGAttribute "line"
  71 | y1 = LOP "y1"
  72 | 
  73 | export %inline
  74 | x2 : LengthOrPercentage -> SVGAttribute "line"
  75 | x2 = LOP "x2"
  76 | 
  77 | export %inline
  78 | y2 : LengthOrPercentage -> SVGAttribute "line"
  79 | y2 = LOP "y2"
  80 | 
  81 | export %inline
  82 | xmlns : String -> SVGAttribute "svg"
  83 | xmlns = Str "xmlns"
  84 | 
  85 | export %inline
  86 | xmlns_2000 : SVGAttribute "svg"
  87 | xmlns_2000 = xmlns "http://www.w3.org/2000/svg"
  88 | 
  89 | parameters {0 s : String}
  90 | 
  91 |   svgCol : String -> SVGColor -> SVGAttribute s
  92 |   svgCol n c =
  93 |     case c of
  94 |       RGBA r g b a => Style n "\{RGB r g b};\{n}-opacity:\{show $ a.value / 100.0}"
  95 |       _            => Style n (interpolate c)
  96 | 
  97 |   export %inline
  98 |   transform : Transform -> SVGAttribute s
  99 |   transform = Str "transform" . interpolate
 100 | 
 101 |   export %inline
 102 |   transforms : List Transform -> SVGAttribute s
 103 |   transforms = Str "transform" . unwords . map interpolate
 104 | 
 105 |   export %inline
 106 |   translateX : (dx : Double) -> SVGAttribute s
 107 |   translateX dx = transform (Translate dx 0)
 108 | 
 109 |   export %inline
 110 |   translateY : (dy : Double) -> SVGAttribute s
 111 |   translateY dy = transform (Translate 0 dy)
 112 | 
 113 |   export %inline
 114 |   translate : (dx,dy : Double) -> SVGAttribute s
 115 |   translate dx dy = transform (Translate dx dy)
 116 | 
 117 |   export %inline
 118 |   rotate : (ang : Double) -> SVGAttribute s
 119 |   rotate ang = transform (Rotate ang)
 120 | 
 121 |   export %inline
 122 |   scaleX : (x : Double) -> SVGAttribute s
 123 |   scaleX x = transform (Scale x 1)
 124 | 
 125 |   export %inline
 126 |   scaleY : (y : Double) -> SVGAttribute s
 127 |   scaleY y = transform (Scale 1 y)
 128 | 
 129 |   export %inline
 130 |   scaleXY : (x,y : Double) -> SVGAttribute s
 131 |   scaleXY x y = transform (Scale x y)
 132 | 
 133 |   export %inline
 134 |   scale : (v : Double) -> SVGAttribute s
 135 |   scale v = transform (Scale v v)
 136 | 
 137 |   export %inline
 138 |   class : String -> SVGAttribute s
 139 |   class = Str "class"
 140 | 
 141 |   export %inline
 142 |   classes : List String -> SVGAttribute s
 143 |   classes = Str "class" . unwords
 144 | 
 145 |   export %inline
 146 |   cx : (0 prf : HasCX s) => LengthOrPercentage -> SVGAttribute s
 147 |   cx = LOP "cx"
 148 | 
 149 |   export %inline
 150 |   cy : (0 prf : HasCX s) => LengthOrPercentage -> SVGAttribute s
 151 |   cy = LOP "cy"
 152 | 
 153 |   export %inline
 154 |   rx : (0 prf : HasRX s) => LengthOrPercentage -> SVGAttribute s
 155 |   rx = LOP "rx"
 156 | 
 157 |   export %inline
 158 |   ry : (0 prf : HasRY s) => LengthOrPercentage -> SVGAttribute s
 159 |   ry = LOP "ry"
 160 | 
 161 |   export %inline
 162 |   x : (0 prf : HasX s) => LengthOrPercentage -> SVGAttribute s
 163 |   x = LOP "x"
 164 | 
 165 |   export %inline
 166 |   y : (0 prf : HasY s) => LengthOrPercentage -> SVGAttribute s
 167 |   y = LOP "y"
 168 | 
 169 |   export %inline
 170 |   fill : (0 p : HasFill s) => SVGColor -> SVGAttribute s
 171 |   fill = svgCol "fill"
 172 | 
 173 |   export %inline
 174 |   fillOpacity : (0 p : HasFill s) => Percentage -> SVGAttribute s
 175 |   fillOpacity = Style "fill-opacity" . interpolate
 176 | 
 177 |   export %inline
 178 |   stroke : (0 p : HasStroke s) => SVGColor -> SVGAttribute s
 179 |   stroke = svgCol "stroke"
 180 | 
 181 |   export %inline
 182 |   strokeLinecap : (0 p : HasStroke s) => StrokeLinecap -> SVGAttribute s
 183 |   strokeLinecap = Style "stroke-linecap" . interpolate
 184 | 
 185 |   export %inline
 186 |   strokeLinejoin : (0 p : HasStroke s) => StrokeLinejoin -> SVGAttribute s
 187 |   strokeLinejoin = Style "stroke-linejoin" . interpolate
 188 | 
 189 |   export %inline
 190 |   strokeOpacity : (0 p : HasStroke s) => Percentage -> SVGAttribute s
 191 |   strokeOpacity = Style "stroke-opacity" . interpolate
 192 | 
 193 |   export %inline
 194 |   width : (0 prf : HasWidth s) => LengthOrPercentage -> SVGAttribute s
 195 |   width = LOP "width"
 196 | 
 197 |   export %inline
 198 |   height : (0 prf : HasHeight s) => LengthOrPercentage -> SVGAttribute s
 199 |   height = LOP "height"
 200 | 
 201 |   export %inline
 202 |   strokeWidth : (0 p : HasStroke s) => LengthOrPercentage -> SVGAttribute s
 203 |   strokeWidth = Style "stroke-width" . interpolate
 204 | 
 205 |   export
 206 |   strokeDasharray : (0 p : HasStroke s) => List Double -> SVGAttribute s
 207 |   strokeDasharray = Style "stroke-dasharray" . unwords . map renderDouble
 208 | 
 209 |   export
 210 |   strokeDashoffset : (0 p : HasStroke s) => Double -> SVGAttribute s
 211 |   strokeDashoffset = Style "stroke-dashoffset" . renderDouble
 212 | 
 213 |   export
 214 |   points : (0 p : HasPoints s) => List Double -> SVGAttribute s
 215 |   points = Points "points"
 216 | 
 217 |   export
 218 |   viewBox :
 219 |        {auto 0 prf : HasViewBox s}
 220 |     -> (minX, minY, width, height : LengthOrPercentage)
 221 |     -> SVGAttribute s
 222 |   viewBox mx my w h = Str "viewBox" "\{mx} \{my} \{w} \{h}"
 223 | 
 224 |   export %inline
 225 |   dominantBaseline : (0 p : IsText s) => DominantBaseline -> SVGAttribute s
 226 |   dominantBaseline = Style "dominant-baseline" . interpolate
 227 | 
 228 |   export %inline
 229 |   textAnchor : (0 p : IsText s) => TextAnchor -> SVGAttribute s
 230 |   textAnchor = Style "text-anchor" . interpolate
 231 | 
 232 |   export %inline
 233 |   font : (0 p : IsText s) => String -> SVGAttribute s
 234 |   font = Style "font"
 235 | 
 236 |   export %inline
 237 |   fontFamily : (0 p : IsText s) => String -> SVGAttribute s
 238 |   fontFamily = Style "font-family"
 239 | 
 240 |   export %inline
 241 |   fontWeight : (0 p : IsText s) => FontWeight -> SVGAttribute s
 242 |   fontWeight = Style "font-weight" . interpolate
 243 | 
 244 |   export %inline
 245 |   lengthAdjust : (0 p : IsText s) => LengthAdjust -> SVGAttribute s
 246 |   lengthAdjust = Str "lengthAdjust" . interpolate
 247 | 
 248 |   export %inline
 249 |   textLength : (0 p : IsText s) => LengthOrPercentage -> SVGAttribute s
 250 |   textLength = LOP "textLength"
 251 | 
 252 |   export %inline
 253 |   dx : (0 p : IsText s) => LengthOrPercentage -> SVGAttribute s
 254 |   dx = LOP "dx"
 255 | 
 256 |   export %inline
 257 |   dy : (0 p : IsText s) => LengthOrPercentage -> SVGAttribute s
 258 |   dy = LOP "dy"
 259 | 
 260 |   export %inline
 261 |   fontSize : (0 p : IsText s) => LengthOrPercentage -> SVGAttribute s
 262 |   fontSize = Style "font-size" . interpolate
 263 |