color.ml 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. open Types
  2. let hex6 = Str.regexp "\\([0-9a-f]\\)\\1\\([0-9a-f]\\)\\2\\([0-9a-f]\\)\\3"
  3. let is_num = function
  4. | Number (n, (None | Some "%")) -> true
  5. | _ -> false
  6. let clip = function
  7. | Number (n, (None | Some "%")) when n < 0. -> Number (0., Some "%")
  8. | Number (n, None) when n > 255. -> Number (255., None)
  9. | Number (n, Some "%") when n > 100. -> Number (100., Some "%")
  10. | value -> value
  11. let rec short = function
  12. | Ident "black" -> Hexcolor "000"
  13. | Ident "fuchsia" -> Hexcolor "f0f"
  14. | Ident "white" -> Hexcolor "fff"
  15. | Ident "yellow" -> Hexcolor "ff0"
  16. | Hexcolor "808080" -> Ident "gray"
  17. | Hexcolor "008000" -> Ident "green"
  18. | Hexcolor "800000" -> Ident "maroon"
  19. | Hexcolor "000080" -> Ident "navy"
  20. | Hexcolor "8080000"-> Ident "olive"
  21. | Hexcolor "800080" -> Ident "purple"
  22. | Hexcolor "ff0000"
  23. | Hexcolor "f00" -> Ident "red"
  24. | Hexcolor "c0c0c0" -> Ident "silver"
  25. | Hexcolor "008080" -> Ident "teal"
  26. (* #aabbcc -> #abc *)
  27. | Hexcolor h when Str.string_match hex6 h 0 ->
  28. let gr n = Str.matched_group n h in
  29. Hexcolor (gr 1 ^ gr 2 ^ gr 3)
  30. (* rgb(r,g,b) -> #rrggbb *)
  31. | Function ("rgb", Nary (",", [r; g; b]))
  32. when is_num r && is_num g && is_num b ->
  33. let i c =
  34. match clip c with
  35. | Number (n, None) -> int_of_float n
  36. | Number (n, Some "%") -> int_of_float (n *. 2.55 +. 0.5)
  37. | _ -> assert false
  38. in
  39. short (Hexcolor (Printf.sprintf "%02x%02x%02x" (i r) (i g) (i b)))
  40. (* clip rgb values, e.g. rgb(-1,256,0) -> rgb(0,255,0) *)
  41. | Function ("rgb", Nary (",", [r; g; b])) ->
  42. Function ("rgb", Nary (",", [clip r; clip g; clip b]))
  43. (* rgba(r,g,b,1.0) -> rgb(r,g,b) *)
  44. | Function ("rgba", Nary (",", [r; g; b; Number (1., None)])) ->
  45. short (Function ("rgb", Nary (",", [r; g; b])))
  46. | v -> v
  47. let transform = function
  48. | Expr value -> Expr (short value)
  49. | v -> v
  50. let compress = Util.transform_stylesheet transform