(define-record-type hsv 
  (fields h s v))

;; hsv -> double -> hsv
(define hsv-scale
  (lambda (c n)
    (let ((h (hsv-h c))
          (s (hsv-s c))
          (v (hsv-v c)))
      (make-hsv (* h n)
                (* s n)
                (* v n)))))

;; hsv -> hsv
(define hsv-inverse
  (lambda (c)
    (let ((h (hsv-h c))
          (s (hsv-s c))
          (v (hsv-v c)))
      (make-hsv (- 1 h)
                (- 1 s)
                (- 1 v)))))

;; hsv -> rgb
(define hsv->rgb
  (lambda (c)
    (let ((h (hsv-h c))
          (s (hsv-s c))
          (v (hsv-v c)))
      (if (zero? s)
          (make-rgb v v v)
          (let* ((hh  (* 6 (if (>= h 1) 0 h)))
                 (f   (- hh (floor hh)))
                 (p   (* v (- 1 s)))
                 (q   (* v (- 1 (* s f))))
                 (t   (* v (- 1 (* s (- 1 f)))))
                 (hhh (exact (floor hh))))
            (cond ((= hhh 0) (make-rgb v t p))
                  ((= hhh 1) (make-rgb q v p))
                  ((= hhh 2) (make-rgb p v t))
                  ((= hhh 3) (make-rgb p q v))
                  ((= hhh 4) (make-rgb t p v))
                  ((= hhh 5) (make-rgb v p q))
                  (else      (error "hsv->rgb: illegal input" h s v hh hhh))))))))

;; rgb -> hsv
(define rgb->hsv
  (lambda (c)
    (let ((r (rgb-r c))
          (g (rgb-g c))
          (b (rgb-b c)))
      (let* ((upper (max r g b))
             (lower (min r g b))
             (delta (- upper lower))
             (v     upper)
             (s     (if (> upper 0) (/ delta upper) 0))
             (z     (if (zero? s)
                        0
                        (/ (cond ((= r upper) (/ (- g b) delta))
                                 ((= g upper) (+ 2 (/ (- b r) delta)))
                                 ((= g upper) (+ 4 (/ (- r g) delta)))
                                 (else        (error "rgb->hsv: impossible")))
                           6)))
             (h     (if (< z 0) (+ z 1) z)))
        (make-hsv h s v)))))

;; hsv -> hsv -> double -> hsv
(define gradient->hsv
  (lambda (c1 c2 n)
    (let ((h1 (hsv-h c1))
          (s1 (hsv-s c1))
          (v1 (hsv-v c1))
          (h2 (hsv-h c2))
          (s2 (hsv-s c2))
          (v2 (hsv-v c2)))
      (if (or (< n 0) (> n 1))
          (error "gradient->hsv: domain error" n)
          (make-hsv (+ (* (- h2 h1) n) h1)
                    (+ (* (- s2 s1) n) s1)
                    (+ (* (- v2 v1) n) s1))))))