(test-group "gamma-compress / gamma-expand"
  (for-each
   (lambda (pair)
     (let ((expanded (car pair))
           (compressed (cdr pair)))
       (test-assert (sprintf "(gamma-compress ~A)" expanded)
         (near? compressed (gamma-compress expanded)))
       (test-assert (sprintf "(gamma-expand ~A)" compressed)
         (near? expanded (gamma-expand compressed)))))
   `((0.0                . 0.0)
     (0.001              . 0.0000773993808049536)
     (0.01292            . 0.001)
     (0.04044            . 0.0031300309597523217)
     (0.04045            . 0.0031308049535603713)
     (0.04046            . 0.0031315789473684214)
     (0.1                . 0.010022825574869039)
     (0.349190212628294  . 0.1)
     (0.5                . 0.21404114048223255)
     (0.735356983052449  . 0.5)
     (1.0                . 1.0)
     (1.5                . 2.537155239391517)
     (10.0               . 223.826324462891)))

  (define (test-spread spread step #!optional (e 1e-6))
    (do ((x (- spread) (+ x step)))
        ((>= x spread) #t)
      (assert (near? x (gamma-compress (gamma-expand x)) e)
              (sprintf "(gamma-compress (gamma-expand ~A))" x))
      (assert (near? x (gamma-expand (gamma-compress x)) e)
              (sprintf "(gamma-expand (gamma-compress ~A))" x))))

  (test-assert "inverses (close spread)"
    (test-spread 0.05 1e-6))

  (test-assert "inverses (mid spread)"
    (test-spread 1 1e-4))

  (test-assert "inverses (wide spread)"
    (test-spread 1e3 5 1e-3)))


(test-group "rgb->rgb8"
  (define (do-test input expected)
    (test-assert (apply sprintf "(rgb ~A ~A ~A ~A)" input)
      (rgb8= (apply rgb8 expected)
             (rgb->rgb8 (apply rgb input)))))

  (do-test '(-0.1 -0.1 -0.1 -0.1) '(0 0 0 0))
  (do-test '(0.0 0.0 0.0 0.0) '(0 0 0 0))
  (do-test '(0.1 0.2 0.3 0.4) '(2 8 18 102))
  (do-test '(1.0 1.0 1.0 1.0) '(255 255 255 255))
  (do-test '(1.1 1.1 1.1 1.1) '(255 255 255 255)))


(test-group "rgb8->rgb"
  (define (do-test input expected)
    (test-assert (apply sprintf "(rgb8 ~A ~A ~A ~A)" input)
      (rgb-near? (apply rgb expected)
                 (rgb8->rgb (apply rgb8 input)))))

  (do-test '(0 0 0 0) '(0.0 0.0 0.0 0.0))
  (do-test '(12 34 56 78)
           '(0.240247502923012
             0.400662869215012
             0.505969285964966
             0.30588236451149))
  (do-test '(212 234 156 178)
           '(0.921863794326782
             0.962889552116394
             0.804665148258209
             0.698039215686274))
  (do-test '(255 255 255 255) '(1.0 1.0 1.0 1.0)))


(test-group "rgb->hsl"
  (define (do-test input expected)
    (test-assert (apply sprintf "(rgb ~A ~A ~A ~A)" input)
      (hsl-near? (apply hsl expected)
                 (rgb->hsl (apply rgb input))
                 1e-3)))

  (do-test '(0.0 0.0 0.0 0.0) '(0.0 0.0 0.0 0.0))
  (do-test '(1.0 1.0 1.0 1.0) '(0.0 0.0 1.0 1.0))
  (do-test '(1.0 0.0 0.0 0.1) '(0.0 1.0 0.5 0.1))
  (do-test '(0.0 1.0 0.0 0.2) '(120.0 1.0 0.5 0.2))
  (do-test '(0.0 0.0 1.0 0.3) '(240.0 1.0 0.5 0.3))
  (do-test '(0.1 0.2 0.3 0.4) '(218.0924 0.7592 0.0416 0.4))
  (do-test '(0.5 1.0 0.2 0.5) '(108.7721 1.0000 0.5166 0.5)))

(test-group "hsl->rgb"
  (define (do-test input expected)
    (test-assert (apply sprintf "(hsl ~A ~A ~A ~A)" input)
      (rgb-near? (apply rgb expected)
                 (hsl->rgb (apply hsl input))
                 1e-3)))

  (do-test '(0.0 0.0 0.0 0.0) '(0.0 0.0 0.0 0.0))
  (do-test '(0.0 0.0 1.0 1.0) '(1.0 1.0 1.0 1.0))
  (do-test '(0.0 1.0 0.5 0.1) '(1.0 0.0 0.0 0.1))
  (do-test '(120.0 1.0 0.5 0.2) '(0.0 1.0 0.0 0.2))
  (do-test '(240.0 1.0 0.5 0.3) '(0.0 0.0 1.0 0.3))
  (do-test '(218.0924 0.7592 0.0416 0.4) '(0.1 0.2 0.3 0.4))
  (do-test '(108.7721 1.0000 0.5166 0.5) '(0.5 1.0 0.2 0.5)))


(test-group "hsl->rgb8"
  (define (do-test input expected)
    (test-assert (apply sprintf "(hsl ~A ~A ~A ~A)" input)
      (rgb8= (apply rgb8 expected)
             (hsl->rgb8 (apply hsl input)))))
  (do-test '(0.0 0.0 0.0 0.0) '(0 0 0 0))
  (do-test '(0.0 0.0 1.0 1.0) '(255 255 255 255))
  (do-test '(0.0 1.0 0.5 1.0) '(255 0 0 255))
  (do-test '(120.0 1.0 0.5 1.0) '(0 255 0 255))
  (do-test '(240.0 1.0 0.5 1.0) '(0 0 255 255))
  (do-test '(210.0 0.5 0.2 1.0) '(25 51 76 255))
  (do-test '(98.0 1.0 0.6 0.5) '(125 255 51 127)))


(test-group "rgb8->hsl"
  (define (do-test input expected)
    (test-assert (apply sprintf "(rgb8 ~A ~A ~A ~A)" input)
      (hsl-near? (apply hsl expected)
                 (rgb8->hsl (apply rgb8 input))
                 1e-3)))

  (do-test '(0 0 0 0) '(0.0 0.0 0.0 0.0))
  (do-test '(255 255 255 255) '(0.0 0.0 1.0 1.0))
  (do-test '(255 0 0 255) '(0.0 1.0 0.5 1.0))
  (do-test '(0 255 0 255) '(120.0 1.0 0.5 1.0))
  (do-test '(0 0 255 255) '(240.0 1.0 0.5 1.0))
  (do-test '(25 51 76 255) '(209.412 0.505 0.198 1.0))
  (do-test '(125 255 51 127) '(98.235 1.0 0.6 0.498)))


(test-group "color->rgb"
  (let ((c (rgb 1 2 3 4)))
    (test-assert (eq? c (color->rgb c)))
    (test-assert (rgb= c (rgb 1 2 3 4))))
  (test-assert (rgb= (color->rgb (rgb8 1 2 3 4))
                     (rgb8->rgb (rgb8 1 2 3 4))))
  (test-assert (rgb= (color->rgb (hsl 1 2 3 4))
                     (hsl->rgb (hsl 1 2 3 4))))
  (test-error (color->rgb '(1 2 3 4)))
  (test-error (color->rgb #f32(1 2 3 4))))

(test-group "color->rgb/new"
  (let ((c (rgb 1 2 3 4)))
    (test-assert (not (eq? c (color->rgb/new c))))
    (test-assert (rgb= c (color->rgb/new c))))
  (test-assert (rgb= (color->rgb/new (rgb8 1 2 3 4))
                     (rgb8->rgb (rgb8 1 2 3 4))))
  (test-assert (rgb= (color->rgb/new (hsl 1 2 3 4))
                     (hsl->rgb (hsl 1 2 3 4))))
  (test-error (color->rgb/new '(1 2 3 4)))
  (test-error (color->rgb/new #f32(1 2 3 4))))


(test-group "color->rgb8"
  (let ((c (rgb8 1 2 3 4)))
    (test-assert (eq? c (color->rgb8 c)))
    (test-assert (rgb8= c (rgb8 1 2 3 4))))
  (test-assert (rgb8= (color->rgb8 (rgb 1 2 3 4))
                      (rgb->rgb8 (rgb 1 2 3 4))))
  (test-assert (rgb8= (color->rgb8 (hsl 1 2 3 4))
                      (hsl->rgb8 (hsl 1 2 3 4))))
  (test-error (color->rgb8 '(1 2 3 4)))
  (test-error (color->rgb8 #u8(1 2 3 4))))

(test-group "color->rgb8/new"
  (let ((c (rgb8 1 2 3 4)))
    (test-assert (not (eq? c (color->rgb8/new c))))
    (test-assert (rgb8= c (color->rgb8/new c))))
  (test-assert (rgb8= (color->rgb8/new (rgb 1 2 3 4))
                      (rgb->rgb8 (rgb 1 2 3 4))))
  (test-assert (rgb8= (color->rgb8/new (hsl 1 2 3 4))
                      (hsl->rgb8 (hsl 1 2 3 4))))
  (test-error (color->rgb8/new '(1 2 3 4)))
  (test-error (color->rgb8/new #u8(1 2 3 4))))


(test-group "color->hsl"
  (let ((c (hsl 1 2 3 4)))
    (test-assert (eq? c (color->hsl c)))
    (test-assert (hsl= c (hsl 1 2 3 4))))
  (test-assert (hsl= (color->hsl (rgb 1 2 3 4))
                     (rgb->hsl (rgb 1 2 3 4))))
  (test-assert (hsl= (color->hsl (rgb8 1 2 3 4))
                     (rgb8->hsl (rgb8 1 2 3 4))))
  (test-error (color->hsl '(1 2 3 4)))
  (test-error (color->hsl #f32(1 2 3 4))))

(test-group "color->hsl/new"
  (let ((c (hsl 1 2 3 4)))
    (test-assert (not (eq? c (color->hsl/new c))))
    (test-assert (hsl= c (color->hsl/new c))))
  (test-assert (hsl= (color->hsl/new (rgb 1 2 3 4))
                     (rgb->hsl (rgb 1 2 3 4))))
  (test-assert (hsl= (color->hsl/new (rgb8 1 2 3 4))
                     (rgb8->hsl (rgb8 1 2 3 4))))
  (test-error (color->hsl/new '(1 2 3 4)))
  (test-error (color->hsl/new #f32(1 2 3 4))))