Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: c58a753bd9
Fetching contributors…

Cannot retrieve contributors at this time

142 lines (109 sloc) 3.782 kb
(ns cssgen.types
(:require [clojure.string :as s]
[clojure.algo.generic.arithmetic :as generic]))
;; copied from contrib
(defn- as-str [x]
(if (instance? clojure.lang.Named x)
(name x)
(str x)))
(defprotocol Value
(repr [x]))
(defrecord Length [mag unit]
(repr [_] (str (as-str mag) (as-str unit))))
(defrecord Color [r g b]
(repr [_] (format "#%02X%02X%02X" (int r) (int g) (int b))))
(extend-protocol Value
(repr [_] "")
(repr [v] (s/join " " (map repr v)))
(repr [k] (name k))
(repr [s] s)
(repr [i] (.toString i)))
(defn- make-color
([r g b] (letfn [(limit [x] (max 0 (min x 255)))]
(Color. (limit r) (limit g) (limit b))))
([string] (letfn [(remove-number-sign [s] (s/replace-first s #"#" ""))
(duplicate [s] (if (= (.length s) 3) (apply str (interleave s s)) s))]
(let [components (->> string as-str remove-number-sign duplicate (re-seq #".."))
[r g b] (map #(Integer/parseInt % 16) components)]
(make-color r g b)))))
(defn- make-length [mag unit]
{:pre [(number? mag)]}
(Length. mag (as-str unit)))
(defmacro ^{:private true} def-length-constr [name]
`(defn ~name [x#] (make-length x# ~(keyword name))))
(def-length-constr em)
(def-length-constr ex)
(def-length-constr px)
(def-length-constr in)
(def-length-constr cm)
(def-length-constr mm)
(def-length-constr pt)
(def-length-constr pc)
(def-length-constr %)
(def-length-constr deg)
(defn col
([x] (make-color x))
([r g b] (make-color r g b)))
(def $ col)
(defmethod generic/+ [Length Length]
[{ua :unit ma :mag} {ub :unit mb :mag}]
{:pre [(= ua ub)]}
(make-length (+ ma mb) ua))
(defmethod generic/- Length
[{ua :unit ma :mag}]
(make-length (- ma) ua))
(defmethod generic/- [Length Length]
[{ua :unit ma :mag} {ub :unit mb :mag}]
{:pre [(= ua ub)]}
(make-length (- ma mb) ua))
(defmethod generic/* [Length Number]
[{ua :unit ma :mag} num]
(make-length (* ma num) ua))
(defmethod generic/* [Number Length]
[num {ua :unit ma :mag}]
(make-length (* ma num) ua))
(generic/defmethod* generic / [Length Number]
[{ua :unit ma :mag} num]
(make-length ((generic/qsym generic /) ma num) ua))
(defmacro ^{:private true} compwise-col-col-op [sym f]
(let [f f]
`(defmethod ~sym [Color Color]
[{ra# :r ga# :g ba# :b} {rb# :r gb# :g bb# :b}]
(make-color (~f ra# rb#) (~f ga# gb#) (~f ba# bb#)))))
(compwise-col-col-op generic/+ +)
(compwise-col-col-op generic/- -)
(compwise-col-col-op generic/* *)
(generic/defmethod* generic / [Color Color]
[{ra :r ga :g ba :b} {rb :r gb :g bb :b}]
(make-color ((generic/qsym generic /) ra rb)
((generic/qsym generic /) ga gb)
((generic/qsym generic /) ba bb)))
(defmacro ^{:private true} compwise-col-num-op [sym f]
(let [f f]
(defmethod ~sym [Color Number]
[{r# :r g# :g b# :b} num#]
(make-color (~f r# num#) (~f g# num#) (~f b# num#)))
(defmethod ~sym [Number Color]
[num# {r# :r g# :g b# :b}]
(make-color (~f num# r#) (~f num# g#) (~f num# b#))))))
(compwise-col-num-op generic/+ +)
(compwise-col-num-op generic/- -)
(compwise-col-num-op generic/* *)
(generic/defmethod* generic / [Color Number]
[{r :r g :g b :b} num]
(make-color ((generic/qsym generic /) r num)
((generic/qsym generic /) g num)
((generic/qsym generic /) b num)))
(generic/defmethod* generic / [Number Color]
[num {r :r g :g b :b}]
(make-color ((generic/qsym generic /) num r)
((generic/qsym generic /) num g)
((generic/qsym generic /) num b)))
Jump to Line
Something went wrong with that request. Please try again.