;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ADDITION

(test-group "hsl-add"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-add c1 c2 c3)))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 393.504 1.660 1.040 0.6)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 70 0.8 0.9 0.6))
           (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c3 (rgb8 40 50 60 128))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-add (hsl 10 0.2 0.3 1.0))
          (hsl 10 0.2 0.3 1.0)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-add (hsl 10 0.2 0.3 1.0)
                        (hsl 40 0.5 0.6 0.5)
                        (hsl 70 0.8 0.9 0.6)
                        (hsl 50 0.4 0.3 0.7)
                        (hsl 20 0.1 0.0 0.8))
               (hsl 123 1.29 1.35 1.0)))

  (test-assert "with 1 non-hsl color"
    (hsl= (hsl-add (rgb 0.1 0.2 0.3 1.0))
          (rgb->hsl (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (hsl= (hsl-add (rgb 0.1 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (hsl 70 0.8 0.9 0.6)
                   (rgb 0.5 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (hsl-add (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                   (rgb8->hsl (rgb8 40 50 60 128))
                   (hsl 70 0.8 0.9 0.6)
                   (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                   (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error (hsl-add))

  (test-error (hsl-add '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-add #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-add #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-add (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-add (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-add (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "hsl-add!"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-add! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (hsl-near? c1
                 (hsl 393.504 1.660 1.040 0.6)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c3 (rgb8 40 50 60 128)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-add! (hsl 10 0.2 0.3 1.0))
          (hsl 10 0.2 0.3 1.0)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-add! (hsl 10 0.2 0.3 1.0)
                         (hsl 40 0.5 0.6 0.5)
                         (hsl 70 0.8 0.9 0.6)
                         (hsl 50 0.4 0.3 0.7)
                         (hsl 20 0.1 0.0 0.8))
               (hsl 123 1.29 1.35 1.0)))

  (test-assert "with many assorted colors"
    (hsl= (hsl-add! (hsl 70 0.8 0.9 0.6)
                    (rgb 0.1 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (rgb 0.5 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (hsl-add! (hsl 70 0.8 0.9 0.6)
                    (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                    (rgb8->hsl (rgb8 40 50 60 128))
                    (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                    (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error "with only non-hsl color"
    (hsl-add! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-hsl color first arg"
    (hsl-add! (rgb 0.1 0.2 0.3 1.0)
              (hsl 70 0.8 0.9 0.6)))

  (test-error (hsl-add!))

  (test-error (hsl-add! '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-add! #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-add! #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-add! (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-add! (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-add! (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-add"
  (let* ((c1 (rgb 0.1 0.2 0.3 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-add c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb 0.905 1.036 1.112 1.0)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-add (rgb 0.1 0.2 0.3 1.0))
          (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-add (rgb 0.1 0.2 0.3 1.0)
                        (rgb 0.4 0.5 0.6 0.5)
                        (rgb 0.7 0.8 0.9 0.6)
                        (rgb 0.5 0.4 0.3 0.7)
                        (rgb 0.2 0.1 0.0 0.8))
               (rgb 1.23 1.29 1.35 1.0)))

  (test-assert "with 1 non-rgb color"
    (rgb= (rgb-add (hsl 10 0.2 0.3 1.0))
          (hsl->rgb (hsl 10 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb= (rgb-add (hsl 10 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl 50 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (rgb-add (hsl->rgb (hsl 10 0.2 0.3 1.0))
                   (rgb8->rgb (rgb8 40 50 60 128))
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl->rgb (hsl 50 0.4 0.3 0.7))
                   (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error (rgb-add))

  (test-error (rgb-add (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-add (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-add (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4)))

  (test-error (rgb-add '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-add #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-add #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6))))


(test-group "rgb-add!"
  (let* ((c1 (rgb 0.1 0.2 0.3 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-add! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb-near? c1
                 (rgb 0.905 1.036 1.112 1.0)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-add! (rgb 0.1 0.2 0.3 1.0))
          (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-add! (rgb 0.1 0.2 0.3 1.0)
                         (rgb 0.4 0.5 0.6 0.5)
                         (rgb 0.7 0.8 0.9 0.6)
                         (rgb 0.5 0.4 0.3 0.7)
                         (rgb 0.2 0.1 0.0 0.8))
               (rgb 1.23 1.29 1.35 1.0)))

  (test-assert "with many assorted colors"
    (rgb= (rgb-add! (rgb 0.7 0.8 0.9 0.6)
                    (hsl 10 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (hsl 50 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (rgb-add! (rgb 0.7 0.8 0.9 0.6)
                    (hsl->rgb (hsl 10 0.2 0.3 1.0))
                    (rgb8->rgb (rgb8 40 50 60 128))
                    (hsl->rgb (hsl 50 0.4 0.3 0.7))
                    (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error "with only non-rgb color"
    (rgb-add! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb color first arg"
    (rgb-add! (hsl 10 0.2 0.3 1.0)
              (rgb 0.1 0.2 0.3 1.0)))

  (test-error (rgb-add!))

  (test-error (rgb-add! (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-add! (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-add! (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4)))

  (test-error (rgb-add! '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-add! #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-add! #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6))))


(test-group "rgb8-add"
  (let* ((c1 (rgb8 40 50 60 128))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb8-add c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 187 207 203 128)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 40 50 60 128))
           (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-add (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-add (rgb8 10 20 30 255)
                     (rgb8 40 50 60 50)
                     (rgb8 70 80 90 60)
                     (rgb8 50 40 30 70)
                     (rgb8 20 10 00 80))
           (rgb8 52 60 70 255)))

  (test-assert "with 1 non-rgb8 color"
    (rgb8= (rgb8-add (rgb 0.1 0.2 0.3 1.0))
           (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-add (rgb 0.1 0.2 0.3 1.0)
                     (hsl 40 0.5 0.6 0.5)
                     (rgb8 70 80 90 60)
                     (rgb 0.5 0.4 0.3 0.7)
                     (hsl 20 0.1 0.0 0.9))
           (rgb8-add (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))
                     (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                     (rgb8 70 80 90 60)
                     (rgb->rgb8 (rgb 0.5 0.4 0.3 0.7))
                     (hsl->rgb8 (hsl 20 0.1 0.0 0.9)))))

  (test-assert "upper bound 255"
    (rgb8= (rgb8-add (rgb8 201 202 203 255)
                     (rgb8 128 128 128 255))
           (rgb8 255 255 255 255)))

  (test-error (rgb8-add))

  (test-error (rgb8-add '(1 2 3 4) (rgb8 30 40 50 60)))
  (test-error (rgb8-add #u8(1 2 3 4) (rgb8 30 40 50 60)))
  (test-error (rgb8-add #f32(0.1 0.2 0.3 0.4) (rgb8 30 40 50 60)))

  (test-error (rgb8-add (rgb8 30 40 50 60) '(1 2 3 4)))
  (test-error (rgb8-add (rgb8 30 40 50 60) #u8(1 2 3 4)))
  (test-error (rgb8-add (rgb8 30 40 50 60) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-add!"
  (let* ((c1 (rgb8 40 50 60 128))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb8-add! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 187 207 203 128)))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-add! (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-add! (rgb8 10 20 30 255)
                      (rgb8 40 50 60 50)
                      (rgb8 70 80 90 60)
                      (rgb8 50 40 30 70)
                      (rgb8 20 10 00 80))
           (rgb8 52 60 70 255)))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-add! (rgb8 70 80 90 60)
                      (rgb 0.1 0.2 0.3 1.0)
                      (hsl 40 0.5 0.6 0.5)
                      (rgb 0.5 0.4 0.3 0.7)
                      (hsl 20 0.1 0.0 0.9))
           (rgb8-add! (rgb8 70 80 90 60)
                      (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))
                      (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                      (rgb->rgb8 (rgb 0.5 0.4 0.3 0.7))
                      (hsl->rgb8 (hsl 20 0.1 0.0 0.9)))))

  (test-assert "upper bound 255"
    (rgb8= (rgb8-add! (rgb8 201 202 203 255)
                      (rgb8 128 128 128 255))
           (rgb8 255 255 255 255)))

  (test-error "with only non-rgb8 color"
    (rgb8-add! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-rgb8 color first arg"
    (rgb8-add! (rgb 0.1 0.2 0.3 1.0)
               (rgb8 30 40 50 60)))

  (test-error (rgb8-add!))

  (test-error (rgb8-add! '(1 2 3 4) (rgb8 30 40 50 60)))
  (test-error (rgb8-add! #u8(1 2 3 4) (rgb8 30 40 50 60)))
  (test-error (rgb8-add! #f32(0.1 0.2 0.3 0.4) (rgb8 30 40 50 60)))

  (test-error (rgb8-add! (rgb8 30 40 50 60) '(1 2 3 4)))
  (test-error (rgb8-add! (rgb8 30 40 50 60) #u8(1 2 3 4)))
  (test-error (rgb8-add! (rgb8 30 40 50 60) #f32(0.1 0.2 0.3 0.4))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SUBTRACTION

(test-group "hsl-sub"
  (let* ((c1 (hsl 350 0.8 0.9 0.6))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-sub c1 c2 c3)))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 26.496 -0.060 0.760 0.6)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 350 0.8 0.9 0.6))
           (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c3 (rgb8 40 50 60 128))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-sub (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-sub (hsl 310 0.2 0.3 1.0)
                        (hsl 40 0.5 0.6 0.5)
                        (hsl 70 0.8 0.9 0.6)
                        (hsl 50 0.4 0.3 0.7)
                        (hsl 20 0.1 0.0 0.8))
               (hsl 197 -0.89 -0.75 1.0)))

  (test-assert "with 1 non-hsl color"
    (hsl= (hsl-sub (rgb 0.1 0.2 0.3 1.0))
          (rgb->hsl (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (hsl= (hsl-sub (rgb 0.1 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (hsl 70 0.8 0.9 0.6)
                   (rgb 0.5 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (hsl-sub (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                   (rgb8->hsl (rgb8 40 50 60 128))
                   (hsl 70 0.8 0.9 0.6)
                   (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                   (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error (hsl-sub))

  (test-error (hsl-sub '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-sub #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-sub #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-sub (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-sub (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-sub (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "hsl-sub!"
  (let* ((c1 (hsl 350 0.8 0.9 0.6))
         (c2 (rgb 0.1 0.2 0.3 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-sub! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (hsl-near? c1
                 (hsl 26.496 -0.060 0.760 0.6)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c3 (rgb8 40 50 60 128)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-sub! (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-sub! (hsl 310 0.2 0.3 1.0)
                         (hsl 40 0.5 0.6 0.5)
                         (hsl 70 0.8 0.9 0.6)
                         (hsl 50 0.4 0.3 0.7)
                         (hsl 20 0.1 0.0 0.8))
               (hsl 197 -0.89 -0.75 1.0)))

  (test-assert "with many assorted colors"
    (hsl= (hsl-sub! (hsl 70 0.8 0.9 0.6)
                    (rgb 0.1 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (rgb 0.5 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (hsl-sub! (hsl 70 0.8 0.9 0.6)
                    (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                    (rgb8->hsl (rgb8 40 50 60 128))
                    (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                    (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error "with only non-hsl color"
    (hsl-sub! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-hsl color first arg"
    (hsl-sub! (rgb 0.1 0.2 0.3 1.0)
              (hsl 70 0.8 0.9 0.6)))

  (test-error (hsl-sub!))

  (test-error (hsl-sub! '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-sub! #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-sub! #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-sub! (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-sub! (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-sub! (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-sub"
  (let* ((c1 (rgb 0.1 0.2 0.3 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-sub c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb -0.705 -0.636 -0.512 1.0)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.1 0.2 0.3 1.0))
           (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-sub (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-sub (rgb 0.1 0.2 0.3 1.0)
                        (rgb 0.4 0.5 0.6 0.5)
                        (rgb 0.7 0.8 0.9 0.6)
                        (rgb 0.5 0.4 0.3 0.7)
                        (rgb 0.2 0.1 0.0 0.8))
               (rgb -1.03 -0.89 -0.75 1.0)))

  (test-assert "with 1 non-rgb color"
    (rgb= (rgb-sub (hsl 10 0.2 0.3 1.0))
          (hsl->rgb (hsl 10 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb= (rgb-sub (hsl 10 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl 50 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (rgb-sub (hsl->rgb (hsl 10 0.2 0.3 1.0))
                   (rgb8->rgb (rgb8 40 50 60 128))
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl->rgb (hsl 50 0.4 0.3 0.7))
                   (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error (rgb-sub))

  (test-error (rgb-sub '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-sub #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-sub #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-sub (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-sub (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-sub (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-sub!"
  (let* ((c1 (rgb 0.1 0.2 0.3 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-sub! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb-near? c1
                 (rgb -0.705 -0.636 -0.512 1.0)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-sub! (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (rgb-near? (rgb-sub! (rgb 0.1 0.2 0.3 1.0)
                         (rgb 0.4 0.5 0.6 0.5)
                         (rgb 0.7 0.8 0.9 0.6)
                         (rgb 0.5 0.4 0.3 0.7)
                         (rgb 0.2 0.1 0.0 0.8))
               (rgb -1.03 -0.89 -0.75 1.0)))

  (test-assert "with many assorted colors"
    (rgb= (rgb-sub! (rgb 0.7 0.8 0.9 0.6)
                    (hsl 10 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (hsl 50 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (rgb-sub! (rgb 0.7 0.8 0.9 0.6)
                    (hsl->rgb (hsl 10 0.2 0.3 1.0))
                    (rgb8->rgb (rgb8 40 50 60 128))
                    (hsl->rgb (hsl 50 0.4 0.3 0.7))
                    (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error "with only non-rgb color"
    (rgb-sub! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb color first arg"
    (rgb-sub! (hsl 70 0.8 0.9 0.6)
              (rgb 0.1 0.2 0.3 1.0)))

  (test-error (rgb-sub!))

  (test-error (rgb-sub! '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-sub! #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-sub! #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-sub! (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-sub! (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-sub! (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-sub"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.1 0.2 0.3 1.0))
         (result (rgb8-sub c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 93 93 17 128)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 240 250 160 128))
           (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.1 0.2 0.3 1.0))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-sub (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-sub (rgb8 210 220 230 255)
                     (rgb8 40 50 60 50)
                     (rgb8 70 80 90 60)
                     (rgb8 50 40 30 70)
                     (rgb8 20 10 00 80))
           (rgb8 168 180 190 255)))

  (test-assert "with 1 non-rgb8 color"
    (rgb8= (rgb8-sub (rgb 0.1 0.2 0.3 1.0))
           (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-sub (rgb 1.0 0.9 0.8 1.0)
                     (hsl 40 0.5 0.6 0.5)
                     (rgb8 70 80 90 60)
                     (rgb 0.5 0.4 0.3 0.7)
                     (hsl 20 0.1 0.0 0.9))
           (rgb8-sub (rgb->rgb8 (rgb 1.0 0.9 0.8 1.0))
                     (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                     (rgb8 70 80 90 60)
                     (rgb->rgb8 (rgb 0.5 0.4 0.3 0.7))
                     (hsl->rgb8 (hsl 20 0.1 0.0 0.9)))))

  (test-assert "lower bound 0"
    (rgb8= (rgb8-sub (rgb8 1 2 3 4)
                     (rgb8 255 255 255 255))
           (rgb8 0 0 0 4)))

  (test-error (rgb8-sub))

  (test-error (rgb8-sub '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-sub #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-sub #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-sub (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-sub (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-sub (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-sub!"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.1 0.2 0.3 1.0))
         (result (rgb8-sub! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 93 93 17 128)))
    (test-assert "does not modify other arguments"
      (and (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.1 0.2 0.3 1.0)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-sub! (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-sub! (rgb8 210 220 230 255)
                      (rgb8 40 50 60 50)
                      (rgb8 70 80 90 60)
                      (rgb8 50 40 30 70)
                      (rgb8 20 10 00 80))
           (rgb8 168 180 190 255)))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-sub! (rgb8 230 240 250 160)
                      (rgb 0.1 0.2 0.3 1.0)
                      (hsl 40 0.5 0.6 0.5)
                      (rgb 0.5 0.4 0.3 0.7)
                      (hsl 20 0.1 0.0 0.9))
           (rgb8-sub! (rgb8 230 240 250 160)
                      (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))
                      (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                      (rgb->rgb8 (rgb 0.5 0.4 0.3 0.7))
                      (hsl->rgb8 (hsl 20 0.1 0.0 0.9)))))

  (test-assert "lower bound 0"
    (rgb8= (rgb8-sub! (rgb8 1 2 3 4)
                      (rgb8 255 255 255 255))
           (rgb8 0 0 0 4)))

  (test-error "with only non-rgb8 color"
    (rgb8-sub! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb8 color first arg"
    (rgb8-sub! (hsl 70 0.8 0.9 0.6)
               (rgb8 1 2 3 4)))

  (test-error (rgb8-sub!))

  (test-error (rgb8-sub! '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-sub! #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-sub! #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-sub! (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-sub! (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-sub! (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MULTIPLICATION

(test-group "hsl-mul"
  (let* ((c1 (hsl 7 0.8 3.9 0.6))
         (c2 (rgb 0.1 0.2 0.8 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-mul c1 c2 c3)))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 176199.406 0.463 0.714 0.6)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 7 0.8 3.9 0.6))
           (rgb= c2 (rgb 0.1 0.2 0.8 1.0))
           (rgb8= c3 (rgb8 40 50 60 128))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-mul (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-mul (hsl 3 0.9 0.7 1.0)
                        (hsl 4 0.5 0.6 0.5)
                        (hsl 7 0.8 0.9 0.6)
                        (hsl 5 0.4 0.3 0.7)
                        (hsl 2 0.2 0.6 0.8))
               (hsl 235.980 0.124 0.183 1.0)
               1e-3))

  (test-assert "with 1 non-hsl color"
    (hsl= (hsl-mul (rgb 0.1 0.2 0.3 1.0))
          (rgb->hsl (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (hsl= (hsl-mul (rgb 0.1 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (hsl 70 0.8 0.9 0.6)
                   (rgb 0.5 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (hsl-mul (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                   (rgb8->hsl (rgb8 40 50 60 128))
                   (hsl 70 0.8 0.9 0.6)
                   (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                   (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error (hsl-mul))

  (test-error (hsl-mul '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-mul #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-mul #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-mul (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-mul (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-mul (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "hsl-mul!"
  (let* ((c1 (hsl 7 0.8 3.9 0.6))
         (c2 (rgb 0.1 0.2 0.8 1.0))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-mul! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (hsl-near? c1
                 (hsl 176199.406 0.463 0.714 0.6)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.1 0.2 0.8 1.0))
           (rgb8= c3 (rgb8 40 50 60 128)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-mul! (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-mul! (hsl 3 0.9 0.7 1.0)
                         (hsl 4 0.5 0.6 0.5)
                         (hsl 7 0.8 0.9 0.6)
                         (hsl 5 0.4 0.3 0.7)
                         (hsl 2 0.2 0.6 0.8))
               (hsl 235.980 0.124 0.183 1.0)
               1e-3))

  (test-assert "with many assorted colors"
    (hsl= (hsl-mul! (hsl 70 0.8 0.9 0.6)
                    (rgb 0.1 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (rgb 0.5 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (hsl-mul! (hsl 70 0.8 0.9 0.6)
                    (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                    (rgb8->hsl (rgb8 40 50 60 128))
                    (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                    (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error "with only non-hsl color"
    (hsl-mul! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-hsl color first arg"
    (hsl-mul! (rgb 0.1 0.2 0.3 1.0)
              (hsl 70 0.8 0.9 0.6)))

  (test-error (hsl-mul!))

  (test-error (hsl-mul! '(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-mul! #u8(1 2 3 4) (hsl 123 0.4 0.5 0.6)))
  (test-error (hsl-mul! #f32(0.1 0.2 0.3 0.4) (hsl 123 0.4 0.5 0.6)))

  (test-error (hsl-mul! (hsl 123 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-mul! (hsl 123 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-mul! (hsl 123 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-mul"
  (let* ((c1 (rgb 0.8 1.6 0.4 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-mul c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb 0.565 1.176 0.289 1.0)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.8 1.6 0.4 1.0))
           (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-mul (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-mul (rgb 0.8 0.6 0.4 1.0)
                        (rgb 0.4 0.5 0.6 0.5)
                        (rgb 0.7 0.8 0.9 0.6)
                        (rgb 0.5 0.4 0.3 0.7)
                        (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.227 0.138 0.055 1.0)
               1e-3))

  (test-assert "with 1 non-rgb color"
    (rgb= (rgb-mul (hsl 10 0.2 0.3 1.0))
          (hsl->rgb (hsl 10 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb= (rgb-mul (hsl 10 0.2 0.3 1.0)
                   (rgb8 40 50 60 128)
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl 50 0.4 0.3 0.7)
                   (rgb8 20 10 0 180))
          (rgb-mul (hsl->rgb (hsl 10 0.2 0.3 1.0))
                   (rgb8->rgb (rgb8 40 50 60 128))
                   (rgb 0.7 0.8 0.9 0.6)
                   (hsl->rgb (hsl 50 0.4 0.3 0.7))
                   (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error (rgb-mul))

  (test-error (rgb-mul '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-mul #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-mul #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-mul (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-mul (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-mul (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-mul!"
  (let* ((c1 (rgb 0.8 1.6 0.4 1.0))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-mul! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb-near? c1
                 (rgb 0.565 1.176 0.289 1.0)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-mul! (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-mul! (rgb 0.8 0.6 0.4 1.0)
                         (rgb 0.4 0.5 0.6 0.5)
                         (rgb 0.7 0.8 0.9 0.6)
                         (rgb 0.5 0.4 0.3 0.7)
                         (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.227 0.138 0.055 1.0)
               1e-3))

  (test-assert "with many assorted colors"
    (rgb= (rgb-mul! (rgb 0.7 0.8 0.9 0.6)
                    (hsl 10 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (hsl 50 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (rgb-mul! (rgb 0.7 0.8 0.9 0.6)
                    (hsl->rgb (hsl 10 0.2 0.3 1.0))
                    (rgb8->rgb (rgb8 40 50 60 128))
                    (hsl->rgb (hsl 50 0.4 0.3 0.7))
                    (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error "with only non-rgb color"
    (rgb-mul! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb color first arg"
    (rgb-mul! (hsl 70 0.8 0.9 0.6)
              (rgb 0.1 0.2 0.3 1.0)))

  (test-error (rgb-mul!))

  (test-error (rgb-mul! '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-mul! #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-mul! #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-mul! (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-mul! (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-mul! (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-mul"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 1.0))
         (result (rgb8-mul c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 49 31 10 128)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 240 250 160 128))
           (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 1.0))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-mul (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-mul (rgb8 210 220 230 255)
                     (rgb8 40 50 60 50)
                     (rgb8 70 80 90 60)
                     (rgb8 50 40 30 70)
                     (rgb8 20 10 00 80))
           (rgb8 81 84 88 255)))

  (test-assert "with 1 non-rgb8 color"
    (rgb8= (rgb8-mul (rgb 0.1 0.2 0.3 1.0))
           (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-mul (rgb8 230 240 250 160)
                     (rgb 0.5 0.4 0.8 1.0)
                     (hsl 40 0.5 0.6 0.5)
                     (rgb 0.5 0.4 0.7 0.7)
                     (hsl 20 0.3 0.5 0.9))
           (rgb8-mul (rgb8 230 240 250 160)
                     (rgb->rgb8 (rgb 0.5 0.4 0.8 1.0))
                     (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                     (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                     (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-error (rgb8-mul))

  (test-error (rgb8-mul '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-mul #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-mul #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-mul (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-mul (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-mul (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-mul!"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 1.0))
         (result (rgb8-mul! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 49 31 10 128)))
    (test-assert "does not modify other arguments"
      (and (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 1.0)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-mul! (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-mul (rgb8 210 220 230 255)
                     (rgb8 40 50 60 50)
                     (rgb8 70 80 90 60)
                     (rgb8 50 40 30 70)
                     (rgb8 20 10 00 80))
           (rgb8 81 84 88 255)))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-mul! (rgb8 230 240 250 160)
                      (rgb 0.5 0.4 0.8 1.0)
                      (hsl 40 0.5 0.6 0.5)
                      (rgb 0.5 0.4 0.7 0.7)
                      (hsl 20 0.3 0.5 0.9))
           (rgb8-mul! (rgb8 230 240 250 160)
                      (rgb->rgb8 (rgb 0.5 0.4 0.8 1.0))
                      (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                      (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                      (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-error "with only non-rgb8 color"
    (rgb8-mul! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb8 color first arg"
    (rgb8-mul! (hsl 70 0.8 0.9 0.6)
               (rgb 0.1 0.2 0.3 1.0)))

  (test-error (rgb8-mul!))

  (test-error (rgb8-mul! '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-mul! #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-mul! #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-mul! (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-mul! (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-mul! (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SCALE

(test-group "hsl-scale"
  (let* ((c (hsl 100 0.5 0.7 0.8))
         (result (hsl-scale c 0.75)))
    (test-assert "does not modify first argument"
      (hsl= (hsl 100 0.5 0.7 0.8) c)))

  (test-assert (hsl= (hsl-scale (hsl 100 0.2 0.3 0.4) 0.0)
                     (hsl 0 0.0 0.0 0.4)))
  (test-assert (hsl= (hsl-scale (hsl 100 0.2 0.3 0.4) 0.5)
                     (hsl 50 0.1 0.15 0.4)))
  (test-assert (hsl= (hsl-scale (hsl 100 0.2 0.3 0.4) 1)
                     (hsl 100 0.2 0.3 0.4)))
  (test-assert (hsl= (hsl-scale (hsl 100 0.2 0.3 0.4) 2)
                     (hsl 200 0.4 0.6 0.4)))
  (test-assert (hsl= (hsl-scale (hsl 100 0.2 0.3 0.4) -2.0)
                     (hsl -200 -0.4 -0.6 0.4))))

(test-group "hsl-scale!"
  (let* ((c (hsl 100 0.5 0.7 0.8))
         (result (hsl-scale! c 0.75)))
    (test-assert "modifies first argument"
      (hsl= (hsl 75 0.375 0.525 0.8) c))
    (test-assert "returns first argument"
      (eq? c result)))

  (test-assert (hsl= (hsl-scale! (hsl 100 0.2 0.3 0.4) 0.0)
                     (hsl 0.0 0.0 0.0 0.4)))
  (test-assert (hsl= (hsl-scale! (hsl 100 0.2 0.3 0.4) 0.5)
                     (hsl 50 0.1 0.15 0.4)))
  (test-assert (hsl= (hsl-scale! (hsl 100 0.2 0.3 0.4) 1)
                     (hsl 100 0.2 0.3 0.4)))
  (test-assert (hsl= (hsl-scale! (hsl 100 0.2 0.3 0.4) 2)
                     (hsl 200 0.4 0.6 0.4)))
  (test-assert (hsl= (hsl-scale! (hsl 100 0.2 0.3 0.4) -2.0)
                     (hsl -200 -0.4 -0.6 0.4))))


(test-group "rgb-scale"
  (let* ((c (rgb 0.1 0.5 0.7 0.8))
         (result (rgb-scale c 0.75)))
    (test-assert "does not modify first argument"
      (rgb= (rgb 0.1 0.5 0.7 0.8) c)))

  (test-assert (rgb= (rgb-scale (rgb 0.1 0.2 0.3 0.4) 0.0)
                     (rgb 0 0.0 0.0 0.4)))
  (test-assert (rgb= (rgb-scale (rgb 0.1 0.2 0.3 0.4) 0.5)
                     (rgb 0.05 0.1 0.15 0.4)))
  (test-assert (rgb= (rgb-scale (rgb 0.1 0.2 0.3 0.4) 1)
                     (rgb 0.1 0.2 0.3 0.4)))
  (test-assert (rgb= (rgb-scale (rgb 0.1 0.2 0.3 0.4) 2)
                     (rgb 0.2 0.4 0.6 0.4)))
  (test-assert (rgb= (rgb-scale (rgb 0.1 0.2 0.3 0.4) -2.0)
                     (rgb -0.2 -0.4 -0.6 0.4))))

(test-group "rgb-scale!"
  (let* ((c (rgb 0.1 0.5 0.7 0.8))
         (result (rgb-scale! c 0.75)))
    (test-assert "modifies first argument"
      (rgb= (rgb 0.075 0.375 0.525 0.8) c))
    (test-assert "returns first argument"
      (eq? c result)))

  (test-assert (rgb= (rgb-scale! (rgb 0.1 0.2 0.3 0.4) 0.0)
                     (rgb 0.0 0.0 0.0 0.4)))
  (test-assert (rgb= (rgb-scale! (rgb 0.1 0.2 0.3 0.4) 0.5)
                     (rgb 0.05 0.1 0.15 0.4)))
  (test-assert (rgb= (rgb-scale! (rgb 0.1 0.2 0.3 0.4) 1)
                     (rgb 0.1 0.2 0.3 0.4)))
  (test-assert (rgb= (rgb-scale! (rgb 0.1 0.2 0.3 0.4) 2)
                     (rgb 0.2 0.4 0.6 0.4)))
  (test-assert (rgb= (rgb-scale! (rgb 0.1 0.2 0.3 0.4) -2.0)
                     (rgb -0.2 -0.4 -0.6 0.4))))


(test-group "rgb8-scale"
  (let* ((c (rgb8 132 245 67 178))
         (result (rgb8-scale c 0.75)))
    (test-assert "does not modify first argument"
      (rgb8= (rgb8 132 245 67 178) c)))

  (test-assert (rgb8= (rgb8-scale (rgb8 132 245 67 178) 0)
                      (rgb8 0 0 0 178)))
  (test-assert (rgb8= (rgb8-scale (rgb8 132 245 67 178) 0.5)
                      (rgb8 66 122 33 178)))
  (test-assert (rgb8= (rgb8-scale (rgb8 132 245 67 178) 1)
                      (rgb8 132 245 67 178)))
  (test-assert (rgb8= (rgb8-scale (rgb8 132 245 67 178) 2)
                      (rgb8 255 255 134 178)))
  (test-assert (rgb8= (rgb8-scale (rgb8 132 245 67 178) -2.0)
                      (rgb8 0 0 0 178))))

(test-group "rgb8-scale!"
  (let* ((c (rgb8 132 245 67 178))
         (result (rgb8-scale! c 0.75)))
    (test-assert "modifies first argument"
      (rgb8= (rgb8 99 183 50 178) c))
    (test-assert "returns first argument"
      (eq? c result)))

  (test-assert (rgb8= (rgb8-scale! (rgb8 132 245 67 178) 0)
                      (rgb8 0 0 0 178)))
  (test-assert (rgb8= (rgb8-scale! (rgb8 132 245 67 178) 0.5)
                      (rgb8 66 122 33 178)))
  (test-assert (rgb8= (rgb8-scale! (rgb8 132 245 67 178) 1)
                      (rgb8 132 245 67 178)))
  (test-assert (rgb8= (rgb8-scale! (rgb8 132 245 67 178) 2)
                      (rgb8 255 255 134 178)))
  (test-assert (rgb8= (rgb8-scale! (rgb8 132 245 67 178) -2.0)
                      (rgb8 0 0 0 178))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; LINEAR INTERPOLATION

(test-group "hsl-lerp"
  (let* ((c1 (hsl 0.1 0.2 0.3 0.4))
         (c2 (hsl 0.5 0.6 0.7 0.8))
         (result (hsl-lerp c1 c2 0.3)))
    (test-assert "gives expected result"
      (hsl-near? result (hsl 0.22 0.32 0.42 0.52)))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 0.1 0.2 0.3 0.4))
           (hsl= c2 (hsl 0.5 0.6 0.7 0.8))))))


(test-group "hsl-lerp!"
  (define (do-test label expected c1 c2 t)
    (test-assert label
      (hsl-near? (apply hsl expected) (hsl-lerp c1 c2 t))))

  (let* ((c1 (hsl 0.1 0.2 0.3 0.4))
         (c2 (hsl 0.5 0.6 0.7 0.8))
         (result (hsl-lerp! c1 c2 0.3)))
    (test-assert "modifies first argument"
      (hsl-near? c1 (hsl 0.22 0.32 0.42 0.52)))
    (test-assert "does not modify second argument"
      (hsl= c2 (hsl 0.5 0.6 0.7 0.8)))
    (test-assert "returns first argument"
      (eq? c1 result)))

  (do-test "0 < t < 1"
           '(0.3375 0.6700 0.2975 0.5175)
           (hsl 0.25 0.61 0.21 0.43)
           (hsl 0.60 0.85 0.56 0.78)
           0.25)

  (do-test "t = 0"
           '(0.25 0.61 0.21 0.43)
           (hsl 0.25 0.61 0.21 0.43)
           (hsl 0.60 0.85 0.56 0.78)
           0)

  (do-test "t = 1"
           '(0.60 0.85 0.56 0.78)
           (hsl 0.25 0.61 0.21 0.43)
           (hsl 0.60 0.85 0.56 0.78)
           1)

  (do-test "t < 0"
           '(0.075 0.490 0.035 0.255)
           (hsl 0.25 0.61 0.21 0.43)
           (hsl 0.60 0.85 0.56 0.78)
           -0.5)

  (do-test "t > 1"
           '(0.95 1.09 0.91 1.13)
           (hsl 0.25 0.61 0.21 0.43)
           (hsl 0.60 0.85 0.56 0.78)
           2))


(test-group "rgb-lerp"
  (let* ((c1 (rgb 0.1 0.2 0.3 0.4))
         (c2 (rgb 0.5 0.6 0.7 0.8))
         (result (rgb-lerp c1 c2 0.3)))
    (test-assert "gives expected result"
      (rgb-near? result (rgb 0.22 0.32 0.42 0.52)))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.1 0.2 0.3 0.4))
           (rgb= c2 (rgb 0.5 0.6 0.7 0.8))))))


(test-group "rgb-lerp!"
  (define (do-test label expected c1 c2 t)
    (test-assert label
      (rgb-near? (apply rgb expected) (rgb-lerp! c1 c2 t))))

  (let* ((c1 (rgb 0.1 0.2 0.3 0.4))
         (c2 (rgb 0.5 0.6 0.7 0.8))
         (result (rgb-lerp! c1 c2 0.3)))
    (test-assert "modifies first argument"
      (rgb-near? c1 (rgb 0.22 0.32 0.42 0.52)))
    (test-assert "does not modify second argument"
      (rgb= c2 (rgb 0.5 0.6 0.7 0.8)))
    (test-assert "returns first argument"
      (eq? c1 result)))

  (do-test "0 < t < 1"
           '(0.3375 0.6700 0.2975 0.5175)
           (rgb 0.25 0.61 0.21 0.43)
           (rgb 0.60 0.85 0.56 0.78)
           0.25)

  (do-test "t = 0"
           '(0.25 0.61 0.21 0.43)
           (rgb 0.25 0.61 0.21 0.43)
           (rgb 0.60 0.85 0.56 0.78)
           0)

  (do-test "t = 1"
           '(0.60 0.85 0.56 0.78)
           (rgb 0.25 0.61 0.21 0.43)
           (rgb 0.60 0.85 0.56 0.78)
           1)

  (do-test "t < 0"
           '(0.075 0.490 0.035 0.255)
           (rgb 0.25 0.61 0.21 0.43)
           (rgb 0.60 0.85 0.56 0.78)
           -0.5)

  (do-test "t > 1"
           '(0.95 1.09 0.91 1.13)
           (rgb 0.25 0.61 0.21 0.43)
           (rgb 0.60 0.85 0.56 0.78)
           2))


(test-group "rgb8-lerp"
  (let* ((c1 (rgb8 225 161  21 243))
         (c2 (rgb8  60 185 255 178))
         (result (rgb8-lerp c1 c2 0.3)))
    (test-assert "gives expected result"
      (rgb8= result (rgb8 175 168 91 223)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 225 161  21 243))
           (rgb8= c2 (rgb8  60 185 255 178))))))


(test-group "rgb8-lerp!"
  (define (do-test label expected c1 c2 t)
    (test label expected (rgb8->list (rgb8-lerp! c1 c2 t))))

  (let* ((c1 (rgb8 225 161  21 243))
         (c2 (rgb8  60 185 255 178))
         (result (rgb8-lerp! c1 c2 0.3)))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 175 168 91 223)))
    (test-assert "does not modify second argument"
      (rgb8= c2 (rgb8 60 185 255 178)))
    (test-assert "returns first argument"
      (eq? c1 result)))

  (do-test "0 < t < 1"
           '(33 67 29 51)
           (rgb8 25 61 21 43)
           (rgb8 60 85 56 78)
           0.25)

  (do-test "t = 0"
           '(25 61 21 43)
           (rgb8 25 61 21 43)
           (rgb8 60 85 56 78)
           0)

  (do-test "t = 1"
           '(60 85 56 78)
           (rgb8 25 61 21 43)
           (rgb8 60 85 56 78)
           1)

  (do-test "t < 0"
           '(7 49 3 25)
           (rgb8 25 61 21 43)
           (rgb8 60 85 56 78)
           -0.5)

  (do-test "t > 1"
           '(95 109 91 113)
           (rgb8 25 61 21 43)
           (rgb8 60 85 56 78)
           2))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MIX

(test-group "hsl-mix"
  (let* ((c1 (hsl 80 0.6 0.4 0.9))
         (c2 (rgb 0.4 0.5 0.6 0.5))
         (c3 (rgb8 70 80 90 60))
         (result (hsl-mix (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 113.754 0.180 0.179 0.261)
                 1e-3))
    (test-assert "does not modify given colors"
      (and (hsl= c1 (hsl 80 0.6 0.4 0.9))
           (rgb= c2 (rgb 0.4 0.5 0.6 0.5))
           (rgb8= c3 (rgb8 70 80 90 60)))))

  (test-assert "one hsl color, default weight"
    (hsl= (hsl-mix (list (hsl 10 0.2 0.3 0.4)))
          (hsl 10 0.2 0.3 0.4)))

  (test-assert "one hsl color, custom weight"
    (hsl-near? (hsl-mix (list (hsl 10 0.2 0.3 0.4)) '(0.5))
               (hsl 5 0.1 0.15 0.2)))

  (test-assert "many hsl colors, default weights"
    (hsl-near? (hsl-mix (list (hsl 80 0.6 0.4 0.9)
                              (hsl 40 0.5 0.6 0.5)
                              (hsl 70 0.8 0.9 0.6)
                              (hsl 50 0.4 0.3 0.7)
                              (hsl 70 0.5 0.2 0.8)))
               (hsl 62 0.56 0.48 0.70)))

  (test-assert "many hsl colors, custom weights"
    (hsl-near? (hsl-mix (list (hsl 80 0.6 0.4 0.9)
                              (hsl 40 0.5 0.6 0.5)
                              (hsl 70 0.8 0.9 0.6)
                              (hsl 50 0.4 0.3 0.7)
                              (hsl 70 0.5 0.2 0.8))
                        (list 0.1 0.2 0.3 0.4 0.5))
               (hsl 92 0.81 0.65 1.05)))

  (test-assert "negative weights"
    (hsl-near? (hsl-mix (list (hsl 10 0.2 0.3 0.4)
                              (hsl 50 0.6 0.7 0.8))
                        '(-0.5 -2.0))
               (hsl -105 -1.30 -1.55 -1.80)))

  (test-assert "assorted colors"
    (hsl= (hsl-mix (list (rgb8 70 80 90 60)
                         (rgb 0.4 0.5 0.6 0.5)
                         (hsl 80 0.6 0.4 0.9))
                   (list 0.1 0.2 0.3))
          (hsl-mix (list (color->hsl (rgb8 70 80 90 60))
                         (color->hsl (rgb 0.4 0.5 0.6 0.5))
                         (hsl 80 0.6 0.4 0.9))
                   (list 0.1 0.2 0.3))))

  (test-error "empty colors list"
    (hsl-mix (list)))

  (test-error "too few weights"
    (hsl-mix (list (hsl 10 0.2 0.3 0.4)
                   (hsl 50 0.6 0.7 0.8))
             (list 0.1)))

  (test-error "too many weights"
    (hsl-mix (list (hsl 10 0.2 0.3 0.4)
                   (hsl 50 0.6 0.7 0.8))
             (list 0.1 0.2 0.3))))


(test-group "hsl-mix!"
  (let* ((c1 (hsl 80 0.6 0.4 0.9))
         (c2 (rgb 0.4 0.5 0.6 0.5))
         (c3 (rgb8 70 80 90 60))
         (result (hsl-mix! (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "modifies first color"
      (hsl-near? c1
                 (hsl 113.754 0.180 0.179 0.261)
                 1e-3))
    (test-assert "does not modify other colors"
      (and (rgb= c2 (rgb 0.4 0.5 0.6 0.5))
           (rgb8= c3 (rgb8 70 80 90 60))))
    (test-assert "returns first color"
      (eq? c1 result)))

  (test-assert "one hsl color, default weight"
    (hsl= (hsl-mix! (list (hsl 10 0.2 0.3 0.4)))
          (hsl 10 0.2 0.3 0.4)))

  (test-assert "one hsl color, custom weight"
    (hsl-near? (hsl-mix! (list (hsl 10 0.2 0.3 0.4)) '(0.5))
               (hsl 5 0.1 0.15 0.2)))

  (test-assert "many hsl colors, default weights"
    (hsl-near? (hsl-mix! (list (hsl 80 0.6 0.4 0.9)
                               (hsl 40 0.5 0.6 0.5)
                               (hsl 70 0.8 0.9 0.6)
                               (hsl 50 0.4 0.3 0.7)
                               (hsl 70 0.5 0.2 0.8)))
               (hsl 62 0.56 0.48 0.70)))

  (test-assert "many hsl colors, custom weights"
    (hsl-near? (hsl-mix! (list (hsl 80 0.6 0.4 0.9)
                               (hsl 40 0.5 0.6 0.5)
                               (hsl 70 0.8 0.9 0.6)
                               (hsl 50 0.4 0.3 0.7)
                               (hsl 70 0.5 0.2 0.8))
                         (list 0.1 0.2 0.3 0.4 0.5))
               (hsl 92 0.81 0.65 1.05)))

  (test-assert "negative weights"
    (hsl-near? (hsl-mix! (list (hsl 10 0.2 0.3 0.4)
                               (hsl 50 0.6 0.7 0.8))
                         '(-0.5 -2.0))
               (hsl -105 -1.30 -1.55 -1.80)))

  (test-assert "hsl with assorted colors"
    (hsl= (hsl-mix! (list (hsl 80 0.6 0.4 0.9)
                          (rgb 0.4 0.5 0.6 0.5)
                          (rgb8 70 80 90 60))
                    (list 0.1 0.2 0.3))
          (hsl-mix! (list (hsl 80 0.6 0.4 0.9)
                          (color->hsl (rgb 0.4 0.5 0.6 0.5))
                          (color->hsl (rgb8 70 80 90 60)))
                    (list 0.1 0.2 0.3))))

  (test-error "non-hsl only color"
    (hsl-mix! (list (rgb 0.4 0.5 0.6 0.5))))

  (test-error "non-hsl first color"
    (hsl-mix! (list (rgb 0.4 0.5 0.6 0.5)
                    (hsl 80 0.6 0.4 0.9)
                    (rgb8 70 80 90 60))))

  (test-error "empty colors list"
    (hsl-mix! (list)))

  (test-error "too few weights"
    (hsl-mix! (list (hsl 10 0.2 0.3 0.4)
                    (hsl 50 0.6 0.7 0.8))
              (list 0.1)))

  (test-error "too many weights"
    (hsl-mix! (list (hsl 10 0.2 0.3 0.4)
                    (hsl 50 0.6 0.7 0.8))
              (list 0.1 0.2 0.3))))


(test-group "rgb-mix"
  (let* ((c1 (rgb 0.4 0.5 0.6 0.5))
         (c2 (hsl 80 0.6 0.4 0.9))
         (c3 (rgb8 70 80 90 60))
         (result (rgb-mix (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb 0.353 0.393 0.336 0.300)
                 1e-3))
    (test-assert "does not modify given colors"
      (and (rgb= c1 (rgb 0.4 0.5 0.6 0.5))
           (hsl= c2 (hsl 80 0.6 0.4 0.9))
           (rgb8= c3 (rgb8 70 80 90 60)))))

  (test-assert "one rgb color, default weight"
    (rgb= (rgb-mix (list (rgb 0.1 0.2 0.3 0.4)))
          (rgb 0.1 0.2 0.3 0.4)))

  (test-assert "one rgb color, custom weight"
    (rgb-near? (rgb-mix (list (rgb 0.1 0.2 0.3 0.4)) '(0.5))
               (rgb 0.05 0.1 0.15 0.2)))

  (test-assert "many rgb colors, default weights"
    (rgb-near? (rgb-mix (list (rgb 0.8 0.6 0.4 0.9)
                              (rgb 0.4 0.5 0.6 0.5)
                              (rgb 0.7 0.8 0.9 0.6)
                              (rgb 0.5 0.4 0.3 0.7)
                              (rgb 0.7 0.5 0.2 0.8)))
               (rgb 0.62 0.56 0.48 0.70)))

  (test-assert "many rgb colors, custom weights"
    (rgb-near? (rgb-mix (list (rgb 0.8 0.6 0.4 0.9)
                              (rgb 0.4 0.5 0.6 0.5)
                              (rgb 0.7 0.8 0.9 0.6)
                              (rgb 0.5 0.4 0.3 0.7)
                              (rgb 0.7 0.5 0.2 0.8))
                        (list 0.1 0.2 0.3 0.4 0.5))
               (rgb 0.92 0.81 0.65 1.05)))

  (test-assert "negative weights"
    (rgb-near? (rgb-mix (list (rgb 0.1 0.2 0.3 0.4)
                              (rgb 0.5 0.6 0.7 0.8))
                        '(-0.5 -2.0))
               (rgb -1.05 -1.30 -1.55 -1.80)))

  (test-assert "assorted colors"
    (rgb= (rgb-mix (list (hsl 80 0.6 0.4 0.9)
                         (rgb8 70 80 90 60)
                         (rgb 0.4 0.5 0.6 0.5))
                   (list 0.1 0.2 0.3))
          (rgb-mix (list (color->rgb (hsl 80 0.6 0.4 0.9))
                         (color->rgb (rgb8 70 80 90 60))
                         (rgb 0.4 0.5 0.6 0.5))
                   (list 0.1 0.2 0.3))))

  (test-error "empty colors list"
    (rgb-mix (list)))

  (test-error "too few weights"
    (rgb-mix (list (rgb 0.1 0.2 0.3 0.4)
                   (rgb 0.5 0.6 0.7 0.8))
             (list 0.1)))

  (test-error "too many weights"
    (rgb-mix (list (rgb 0.1 0.2 0.3 0.4)
                   (rgb 0.5 0.6 0.7 0.8))
             (list 0.1 0.2 0.3))))


(test-group "rgb-mix!"
  (let* ((c1 (rgb 0.4 0.5 0.6 0.5))
         (c2 (hsl 80 0.6 0.4 0.9))
         (c3 (rgb8 70 80 90 60))
         (result (rgb-mix! (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "modifies first color"
      (rgb-near? c1
                 (rgb 0.353 0.393 0.336 0.300)
                 1e-3))
    (test-assert "does not modify other colors"
      (and (hsl= c2 (hsl 80 0.6 0.4 0.9))
           (rgb8= c3 (rgb8 70 80 90 60))))
    (test-assert "returns first color"
      (eq? c1 result)))

  (test-assert "one rgb color, default weight"
    (rgb= (rgb-mix! (list (rgb 0.1 0.2 0.3 0.4)))
          (rgb 0.1 0.2 0.3 0.4)))

  (test-assert "one rgb color, custom weight"
    (rgb-near? (rgb-mix! (list (rgb 0.1 0.2 0.3 0.4)) '(0.5))
               (rgb 0.05 0.1 0.15 0.2)))

  (test-assert "many rgb colors, default weights"
    (rgb-near? (rgb-mix! (list (rgb 0.8 0.6 0.4 0.9)
                               (rgb 0.4 0.5 0.6 0.5)
                               (rgb 0.7 0.8 0.9 0.6)
                               (rgb 0.5 0.4 0.3 0.7)
                               (rgb 0.7 0.5 0.2 0.8)))
               (rgb 0.62 0.56 0.48 0.70)))

  (test-assert "many rgb colors, custom weights"
    (rgb-near? (rgb-mix! (list (rgb 0.8 0.6 0.4 0.9)
                               (rgb 0.4 0.5 0.6 0.5)
                               (rgb 0.7 0.8 0.9 0.6)
                               (rgb 0.5 0.4 0.3 0.7)
                               (rgb 0.7 0.5 0.2 0.8))
                         (list 0.1 0.2 0.3 0.4 0.5))
               (rgb 0.92 0.81 0.65 1.05)))

  (test-assert "negative weights"
    (rgb-near? (rgb-mix! (list (rgb 0.1 0.2 0.3 0.4)
                               (rgb 0.5 0.6 0.7 0.8))
                         '(-0.5 -2.0))
               (rgb -1.05 -1.30 -1.55 -1.80)))

  (test-assert "rgb with assorted colors"
    (rgb= (rgb-mix! (list (rgb 0.4 0.5 0.6 0.5)
                          (hsl 80 0.6 0.4 0.9)
                          (rgb8 70 80 90 60))
                    (list 0.1 0.2 0.3))
          (rgb-mix! (list (rgb 0.4 0.5 0.6 0.5)
                          (color->rgb (hsl 80 0.6 0.4 0.9))
                          (color->rgb (rgb8 70 80 90 60)))
                    (list 0.1 0.2 0.3))))

  (test-error "non-rgb only color"
    (rgb-mix! (list (hsl 80 0.6 0.4 0.9))))

  (test-error "non-rgb first color"
    (rgb-mix! (list (hsl 80 0.6 0.4 0.9)
                    (rgb 0.4 0.5 0.6 0.5)
                    (rgb8 70 80 90 60))))

  (test-error "empty colors list"
    (rgb-mix! (list)))

  (test-error "too few weights"
    (rgb-mix! (list (rgb 0.1 0.2 0.3 0.4)
                    (rgb 0.5 0.6 0.7 0.8))
              (list 0.1)))

  (test-error "too many weights"
    (rgb-mix! (list (rgb 0.1 0.2 0.3 0.4)
                    (rgb 0.5 0.6 0.7 0.8))
              (list 0.1 0.2 0.3))))


(test-group "rgb8-mix"
  (let* ((c1 (rgb8 70 80 90 60))
         (c2 (hsl 80 0.6 0.4 0.9))
         (c3 (rgb 0.4 0.5 0.6 0.5))
         (result (rgb8-mix (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 40 56 41 89)))
    (test-assert "does not modify given colors"
      (and (rgb8= c1 (rgb8 70 80 90 60))
           (hsl= c2 (hsl 80 0.6 0.4 0.9))
           (rgb= c3 (rgb 0.4 0.5 0.6 0.5)))))

  (test-assert "one rgb8 color, default weight"
    (rgb8= (rgb8-mix (list (rgb8 10 20 30 40)))
           (rgb8 10 20 30 40)))

  (test-assert "one rgb8 color, custom weight"
    (rgb8= (rgb8-mix (list (rgb8 10 20 30 40)) '(0.5))
           (rgb8 5 10 15 20)))

  (test-assert "many rgb8 colors, default weights"
    (rgb8= (rgb8-mix (list (rgb8 80 60 40 90)
                           (rgb8 40 50 60 50)
                           (rgb8 70 80 90 60)
                           (rgb8 50 40 30 70)
                           (rgb8 70 50 20 80)))
           (rgb8 62 56 48 70)))

  (test-assert "many rgb8 colors, custom weights"
    (rgb8= (rgb8-mix (list (rgb8 80 60 40 90)
                           (rgb8 40 50 60 50)
                           (rgb8 70 80 90 60)
                           (rgb8 50 40 30 70)
                           (rgb8 70 50 20 80))
                     (list 0.1 0.2 0.3 0.4 0.5))
           (rgb8 92 81 65 105)))

  (test-assert "max 255"
    (rgb8= (rgb8-mix (list (rgb8 1 1 1 1))
                     (list 1000))
           (rgb8 255 255 255 255)))

  (test-assert "negative weights"
    (rgb8= (rgb8-mix (list (rgb8 10 20 30 40)
                           (rgb8 50 60 70 80))
                     '(-0.5 -2.0))
           (rgb8 0 0 0 0)))

  (test-assert "assorted colors"
    (rgb8= (rgb8-mix (list (hsl 80 0.6 0.4 0.9)
                           (rgb 0.4 0.5 0.6 0.5)
                           (rgb8 70 80 90 60))
                     (list 0.1 0.2 0.3))
           (rgb8-mix (list (color->rgb8 (hsl 80 0.6 0.4 0.9))
                           (color->rgb8 (rgb 0.4 0.5 0.6 0.5))
                           (rgb8 70 80 90 60))
                     (list 0.1 0.2 0.3))))

  (test-error "empty colors list"
    (rgb8-mix (list)))

  (test-error "too few weights"
    (rgb8-mix (list (rgb8 10 20 30 40)
                    (rgb8 50 60 70 80))
              (list 0.1)))

  (test-error "too many weights"
    (rgb8-mix (list (rgb8 10 20 30 40)
                    (rgb8 50 60 70 80))
              (list 0.1 0.2 0.3))))


(test-group "rgb8-mix!"
  (let* ((c1 (rgb8 70 80 90 60))
         (c2 (hsl 80 0.6 0.4 0.9))
         (c3 (rgb 0.4 0.5 0.6 0.5))
         (result (rgb8-mix! (list c1 c2 c3) '(0.1 0.2 0.3))))
    (test-assert "modifies first color"
      (rgb8= c1 (rgb8 40 56 41 89)))
    (test-assert "does not modify other colors"
      (and (hsl= c2 (hsl 80 0.6 0.4 0.9))
           (rgb= c3 (rgb 0.4 0.5 0.6 0.5))))
    (test-assert "returns first color"
      (eq? c1 result)))

  (test-assert "one rgb8 color, default weight"
    (rgb8= (rgb8-mix! (list (rgb8 10 20 30 40)))
           (rgb8 10 20 30 40)))

  (test-assert "one rgb8 color, custom weight"
    (rgb8= (rgb8-mix! (list (rgb8 10 20 30 40)) '(0.5))
           (rgb8 5 10 15 20)))

  (test-assert "many rgb8 colors, default weights"
    (rgb8= (rgb8-mix! (list (rgb8 80 60 40 90)
                            (rgb8 40 50 60 50)
                            (rgb8 70 80 90 60)
                            (rgb8 50 40 30 70)
                            (rgb8 70 50 20 80)))
           (rgb8 62 56 48 70)))

  (test-assert "many rgb8 colors, custom weights"
    (rgb8= (rgb8-mix! (list (rgb8 80 60 40 90)
                            (rgb8 40 50 60 50)
                            (rgb8 70 80 90 60)
                            (rgb8 50 40 30 70)
                            (rgb8 70 50 20 80))
                      (list 0.1 0.2 0.3 0.4 0.5))
           (rgb8 92 81 65 105)))

  (test-assert "max 255"
    (rgb8= (rgb8-mix! (list (rgb8 1 1 1 1))
                      (list 1000))
           (rgb8 255 255 255 255)))

  (test-assert "negative weights"
    (rgb8= (rgb8-mix! (list (rgb8 10 20 30 40)
                            (rgb8 50 60 70 80))
                      '(-0.5 -2.0))
           (rgb8 0 0 0 0)))

  (test-assert "rgb8 with assorted colors"
    (rgb8= (rgb8-mix! (list (rgb8 70 80 90 60)
                            (rgb 0.4 0.5 0.6 0.5)
                            (hsl 80 0.6 0.4 0.9))
                      (list 0.1 0.2 0.3))
           (rgb8-mix! (list (rgb8 70 80 90 60)
                            (color->rgb8 (rgb 0.4 0.5 0.6 0.5))
                            (color->rgb8 (hsl 80 0.6 0.4 0.9)))
                      (list 0.1 0.2 0.3))))

  (test-error "non-rgb8 only color"
    (rgb8-mix! (list (hsl 80 0.6 0.4 0.9))))

  (test-error "non-rgb8 first color"
    (rgb8-mix! (list (hsl 80 0.6 0.4 0.9)
                     (rgb 0.4 0.5 0.6 0.5)
                     (rgb8 70 80 90 60))))

  (test-error "empty colors list"
    (rgb8-mix! (list)))

  (test-error "too few weights"
    (rgb8-mix! (list (rgb8 10 20 30 40)
                     (rgb8 50 60 70 80))
               (list 0.1)))

  (test-error "too many weights"
    (rgb8-mix! (list (rgb8 10 20 30 40)
                     (rgb8 50 60 70 80))
               (list 0.1 0.2 0.3))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; OVER

(test-group "hsl-over"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.8 1.6 0.4 0.8))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-over c1 c2 c3)))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 81.659 0.842 0.759 0.960)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 70 0.8 0.9 0.6))
           (rgb= c2 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c3 (rgb8 40 50 60 128))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-over (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-over (hsl 80 0.6 0.4 0.4)
                         (hsl 40 0.5 0.6 0.5)
                         (hsl 70 0.8 0.9 0.6)
                         (hsl 50 0.4 0.3 0.7)
                         (hsl 70 0.5 0.2 0.8))
               (hsl 63.272 0.586 0.537 0.993)
               1e-3))

  (test-assert "with 1 non-hsl color"
    (hsl= (hsl-over (rgb 0.1 0.2 0.3 1.0))
          (rgb->hsl (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (hsl= (hsl-over (rgb 0.1 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (hsl 70 0.8 0.9 0.6)
                    (rgb 0.5 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (hsl-over (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                    (rgb8->hsl (rgb8 40 50 60 128))
                    (hsl 70 0.8 0.9 0.6)
                    (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                    (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-assert "top alpha 1.0"
    (hsl= (hsl-over (hsl 80 0.6 0.4 1.0)
                    (hsl 40 0.5 0.6 0.5))
          (hsl 80 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (hsl= (hsl-over (hsl 80 0.6 0.4 0.0)
                    (hsl 40 0.5 0.6 0.5))
          (hsl 40 0.5 0.6 0.5)))

  (test-error (hsl-over))

  (test-error (hsl-over '(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-over #u8(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-over #f32(0.1 0.2 0.3 0.4) (hsl 30 0.4 0.5 0.6)))

  (test-error (hsl-over (hsl 30 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-over (hsl 30 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-over (hsl 30 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "hsl-over!"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.8 1.6 0.4 0.8))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-over! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (hsl-near? c1
                 (hsl 81.659 0.842 0.759 0.960)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c3 (rgb8 40 50 60 128)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-over! (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-over! (hsl 80 0.6 0.4 0.4)
                          (hsl 40 0.5 0.6 0.5)
                          (hsl 70 0.8 0.9 0.6)
                          (hsl 50 0.4 0.3 0.7)
                          (hsl 70 0.5 0.2 0.8))
               (hsl 63.272 0.586 0.537 0.993)
               1e-3))

  (test-assert "with many assorted colors"
    (hsl= (hsl-over! (hsl 70 0.8 0.9 0.6)
                     (rgb 0.1 0.2 0.3 1.0)
                     (rgb8 40 50 60 128)
                     (rgb 0.5 0.4 0.3 0.7)
                     (rgb8 20 10 0 180))
          (hsl-over! (hsl 70 0.8 0.9 0.6)
                     (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                     (rgb8->hsl (rgb8 40 50 60 128))
                     (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                     (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error "with only non-hsl color"
    (hsl-over! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-hsl color first arg"
    (hsl-over! (rgb 0.1 0.2 0.3 1.0)
               (hsl 70 0.8 0.9 0.6)))

  (test-assert "top alpha 1.0"
    (hsl= (hsl-over! (hsl 80 0.6 0.4 1.0)
                     (hsl 40 0.5 0.6 0.5))
          (hsl 80 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (hsl= (hsl-over! (hsl 80 0.6 0.4 0.0)
                     (hsl 40 0.5 0.6 0.5))
          (hsl 40 0.5 0.6 0.5)))

  (test-error (hsl-over!))

  (test-error (hsl-over! '(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-over! #u8(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-over! #f32(0.1 0.2 0.3 0.4) (hsl 30 0.4 0.5 0.6)))

  (test-error (hsl-over! (hsl 30 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-over! (hsl 30 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-over! (hsl 30 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-over"
  (let* ((c1 (rgb 0.8 1.6 0.4 0.8))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-over c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb 0.773 1.445 0.445 0.960)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-over (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-over (rgb 0.8 0.6 0.4 0.4)
                         (rgb 0.4 0.5 0.6 0.5)
                         (rgb 0.7 0.8 0.9 0.6)
                         (rgb 0.5 0.4 0.3 0.7)
                         (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.633 0.586 0.537 0.993)
               1e-3))

  (test-assert "with 1 non-rgb color"
    (rgb= (rgb-over (hsl 10 0.2 0.3 1.0))
          (hsl->rgb (hsl 10 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb= (rgb-over (hsl 10 0.2 0.3 1.0)
                    (rgb8 40 50 60 128)
                    (rgb 0.7 0.8 0.9 0.6)
                    (hsl 50 0.4 0.3 0.7)
                    (rgb8 20 10 0 180))
          (rgb-over (hsl->rgb (hsl 10 0.2 0.3 1.0))
                    (rgb8->rgb (rgb8 40 50 60 128))
                    (rgb 0.7 0.8 0.9 0.6)
                    (hsl->rgb (hsl 50 0.4 0.3 0.7))
                    (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-assert "top alpha 1.0"
    (rgb= (rgb-over (rgb 0.8 0.6 0.4 1.0)
                    (rgb 0.4 0.5 0.6 0.5))
          (rgb 0.8 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (rgb= (rgb-over (rgb 0.8 0.6 0.4 0.0)
                    (rgb 0.4 0.5 0.6 0.5))
          (rgb 0.4 0.5 0.6 0.5)))

  (test-error (rgb-over))

  (test-error (rgb-over '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-over #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-over #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-over (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-over (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-over (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-over!"
  (let* ((c1 (rgb 0.8 1.6 0.4 0.8))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-over! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb-near? c1
                 (rgb 0.773 1.445 0.445 0.960)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-over! (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-over! (rgb 0.8 0.6 0.4 0.4)
                          (rgb 0.4 0.5 0.6 0.5)
                          (rgb 0.7 0.8 0.9 0.6)
                          (rgb 0.5 0.4 0.3 0.7)
                          (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.633 0.586 0.537 0.993)
               1e-3))

  (test-assert "with many assorted colors"
    (rgb= (rgb-over! (rgb 0.7 0.8 0.9 0.6)
                     (hsl 10 0.2 0.3 1.0)
                     (rgb8 40 50 60 128)
                     (hsl 50 0.4 0.3 0.7)
                     (rgb8 20 10 0 180))
          (rgb-over! (rgb 0.7 0.8 0.9 0.6)
                     (hsl->rgb (hsl 10 0.2 0.3 1.0))
                     (rgb8->rgb (rgb8 40 50 60 128))
                     (hsl->rgb (hsl 50 0.4 0.3 0.7))
                     (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error "with only non-rgb color"
    (rgb-over! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb color first arg"
    (rgb-over! (hsl 70 0.8 0.9 0.6)
               (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "top alpha 1.0"
    (rgb= (rgb-over! (rgb 0.8 0.6 0.4 1.0)
                     (rgb 0.4 0.5 0.6 0.5))
          (rgb 0.8 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (rgb= (rgb-over! (rgb 0.8 0.6 0.4 0.0)
                     (rgb 0.4 0.5 0.6 0.5))
          (rgb 0.4 0.5 0.6 0.5)))

  (test-error (rgb-over!))

  (test-error (rgb-over! '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-over! #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-over! #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-over! (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-over! (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-over! (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-over"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 0.2))
         (result (rgb8-over c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 232 238 170 214)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 240 250 160 128))
           (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 0.2))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-over (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-over (rgb8 210 220 230 100)
                      (rgb8 40 50 60 50)
                      (rgb8 70 80 90 60)
                      (rgb8 50 40 30 70)
                      (rgb8 20 10 00 80))
           (rgb8 123 128 134 206)))

  (test-assert "with 1 non-rgb8 color"
    (rgb8= (rgb8-over (rgb 0.1 0.2 0.3 1.0))
           (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-over (rgb8 230 240 250 160)
                      (rgb 0.5 0.4 0.8 0.5)
                      (hsl 40 0.5 0.6 0.5)
                      (rgb 0.5 0.4 0.7 0.7)
                      (hsl 20 0.3 0.5 0.9))
           (rgb8-over (rgb8 230 240 250 160)
                      (rgb->rgb8 (rgb 0.5 0.4 0.8 0.5))
                      (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                      (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                      (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-assert "top alpha 255"
    (rgb8= (rgb8-over (rgb8 210 220 230 255)
                      (rgb8 40 50 60 50))
           (rgb8 210 220 230 255)))

  (test-assert "top alpha 0"
    (rgb8= (rgb8-over (rgb8 210 220 230 0)
                      (rgb8 40 50 60 50))
           (rgb8 40 50 60 50)))

  (test-error (rgb8-over))

  (test-error (rgb8-over '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-over #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-over #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-over (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-over (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-over (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-over!"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 0.2))
         (result (rgb8-over! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 232 238 170 214)))
    (test-assert "does not modify other arguments"
      (and (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 0.2)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-over! (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-over (rgb8 210 220 230 100)
                      (rgb8 40 50 60 50)
                      (rgb8 70 80 90 60)
                      (rgb8 50 40 30 70)
                      (rgb8 20 10 00 80))
           (rgb8 123 128 134 206)))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-over! (rgb8 230 240 250 160)
                       (rgb 0.5 0.4 0.8 0.5)
                       (hsl 40 0.5 0.6 0.5)
                       (rgb 0.5 0.4 0.7 0.7)
                       (hsl 20 0.3 0.5 0.9))
           (rgb8-over! (rgb8 230 240 250 160)
                       (rgb->rgb8 (rgb 0.5 0.4 0.8 0.5))
                       (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                       (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                       (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-error "with only non-rgb8 color"
    (rgb8-over! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb8 color first arg"
    (rgb8-over! (hsl 70 0.8 0.9 0.6)
                (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "top alpha 255"
    (rgb8= (rgb8-over! (rgb8 210 220 230 255)
                       (rgb8 40 50 60 50))
           (rgb8 210 220 230 255)))

  (test-assert "top alpha 0"
    (rgb8= (rgb8-over! (rgb8 210 220 230 0)
                       (rgb8 40 50 60 50))
           (rgb8 40 50 60 50)))

  (test-error (rgb8-over!))

  (test-error (rgb8-over! '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-over! #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-over! #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-over! (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-over! (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-over! (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; UNDER

(test-group "hsl-under"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.8 1.6 0.4 0.8))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-under c1 c2 c3)))
    (test-assert "returns expected result"
      (hsl-near? result
                 (hsl 150.416 0.569 0.394 0.960)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (hsl= c1 (hsl 70 0.8 0.9 0.6))
           (rgb= c2 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c3 (rgb8 40 50 60 128))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-under (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-under (hsl 80 0.6 0.4 0.4)
                          (hsl 40 0.5 0.6 0.5)
                          (hsl 70 0.8 0.9 0.6)
                          (hsl 50 0.4 0.3 0.7)
                          (hsl 70 0.5 0.2 0.8))
               (hsl 66.865 0.497 0.245 0.993)
               1e-3))

  (test-assert "with 1 non-hsl color"
    (hsl= (hsl-under (rgb 0.1 0.2 0.3 1.0))
          (rgb->hsl (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (hsl= (hsl-under (rgb 0.1 0.2 0.3 1.0)
                     (rgb8 40 50 60 128)
                     (hsl 70 0.8 0.9 0.6)
                     (rgb 0.5 0.4 0.3 0.7)
                     (rgb8 20 10 0 180))
          (hsl-under (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                     (rgb8->hsl (rgb8 40 50 60 128))
                     (hsl 70 0.8 0.9 0.6)
                     (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                     (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-assert "top alpha 1.0"
    (hsl= (hsl-under (hsl 40 0.5 0.6 0.5)
                     (hsl 80 0.6 0.4 1.0))
          (hsl 80 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (hsl= (hsl-under (hsl 40 0.5 0.6 0.5)
                     (hsl 80 0.6 0.4 0.0))
          (hsl 40 0.5 0.6 0.5)))

  (test-error (hsl-under))

  (test-error (hsl-under '(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-under #u8(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-under #f32(0.1 0.2 0.3 0.4) (hsl 30 0.4 0.5 0.6)))

  (test-error (hsl-under (hsl 30 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-under (hsl 30 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-under (hsl 30 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "hsl-under!"
  (let* ((c1 (hsl 70 0.8 0.9 0.6))
         (c2 (rgb 0.8 1.6 0.4 0.8))
         (c3 (rgb8 40 50 60 128))
         (result (hsl-under! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (hsl-near? c1
                 (hsl 150.416 0.569 0.394 0.960)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb= c2 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c3 (rgb8 40 50 60 128)))))

  (test-assert "with 1 hsl color"
    (hsl= (hsl-under! (hsl 10 0.2 0.3 0.5))
          (hsl 10 0.2 0.3 0.5)))

  (test-assert "with many hsl colors"
    (hsl-near? (hsl-under! (hsl 80 0.6 0.4 0.4)
                           (hsl 40 0.5 0.6 0.5)
                           (hsl 70 0.8 0.9 0.6)
                           (hsl 50 0.4 0.3 0.7)
                           (hsl 70 0.5 0.2 0.8))
               (hsl 66.865 0.497 0.245 0.993)
               1e-3))

  (test-assert "with many assorted colors"
    (hsl= (hsl-under! (hsl 70 0.8 0.9 0.6)
                      (rgb 0.1 0.2 0.3 1.0)
                      (rgb8 40 50 60 128)
                      (rgb 0.5 0.4 0.3 0.7)
                      (rgb8 20 10 0 180))
          (hsl-under! (hsl 70 0.8 0.9 0.6)
                      (rgb->hsl (rgb 0.1 0.2 0.3 1.0))
                      (rgb8->hsl (rgb8 40 50 60 128))
                      (rgb->hsl (rgb 0.5 0.4 0.3 0.7))
                      (rgb8->hsl (rgb8 20 10 0 180)))))

  (test-error "with only non-hsl color"
    (hsl-under! (rgb 0.1 0.2 0.3 1.0)))

  (test-error "with non-hsl color first arg"
    (hsl-under! (rgb 0.1 0.2 0.3 1.0)
                (hsl 70 0.8 0.9 0.6)))

  (test-assert "top alpha 1.0"
    (hsl= (hsl-under! (hsl 40 0.5 0.6 0.5)
                      (hsl 80 0.6 0.4 1.0))
          (hsl 80 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (hsl= (hsl-under! (hsl 40 0.5 0.6 0.5)
                      (hsl 80 0.6 0.4 0.0))
          (hsl 40 0.5 0.6 0.5)))

  (test-error (hsl-under!))

  (test-error (hsl-under! '(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-under! #u8(1 2 3 4) (hsl 30 0.4 0.5 0.6)))
  (test-error (hsl-under! #f32(0.1 0.2 0.3 0.4) (hsl 30 0.4 0.5 0.6)))

  (test-error (hsl-under! (hsl 30 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (hsl-under! (hsl 30 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (hsl-under! (hsl 30 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-under"
  (let* ((c1 (rgb 0.8 1.6 0.4 0.8))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-under c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb-near? result
                 (rgb 0.835 0.985 0.748 0.960)
                 1e-3))
    (test-assert "does not modify arguments"
      (and (rgb= c1 (rgb 0.8 1.6 0.4 0.8))
           (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-under (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-under (rgb 0.8 0.6 0.4 0.4)
                          (rgb 0.4 0.5 0.6 0.5)
                          (rgb 0.7 0.8 0.9 0.6)
                          (rgb 0.5 0.4 0.3 0.7)
                          (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.669 0.497 0.245 0.993)
               1e-3))

  (test-assert "with 1 non-rgb color"
    (rgb= (rgb-under (hsl 10 0.2 0.3 1.0))
          (hsl->rgb (hsl 10 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb= (rgb-under (hsl 10 0.2 0.3 1.0)
                     (rgb8 40 50 60 128)
                     (rgb 0.7 0.8 0.9 0.6)
                     (hsl 50 0.4 0.3 0.7)
                     (rgb8 20 10 0 180))
          (rgb-under (hsl->rgb (hsl 10 0.2 0.3 1.0))
                     (rgb8->rgb (rgb8 40 50 60 128))
                     (rgb 0.7 0.8 0.9 0.6)
                     (hsl->rgb (hsl 50 0.4 0.3 0.7))
                     (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-assert "top alpha 1.0"
    (rgb= (rgb-under (rgb 0.4 0.5 0.6 0.5)
                     (rgb 0.8 0.6 0.4 1.0))
          (rgb 0.8 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (rgb= (rgb-under (rgb 0.4 0.5 0.6 0.5)
                     (rgb 0.8 0.6 0.4 0.0))
          (rgb 0.4 0.5 0.6 0.5)))

  (test-error (rgb-under))

  (test-error (rgb-under '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-under #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-under #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-under (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-under (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-under (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb-under!"
  (let* ((c1 (rgb 0.8 1.6 0.4 0.8))
         (c2 (rgb8 40 50 60 128))
         (c3 (hsl 70 0.8 0.9 0.6))
         (result (rgb-under! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb-near? c1
                 (rgb 0.835 0.985 0.748 0.960)
                 1e-3))
    (test-assert "does not modify other arguments"
      (and (rgb8= c2 (rgb8 40 50 60 128))
           (hsl= c3 (hsl 70 0.8 0.9 0.6)))))

  (test-assert "with 1 rgb color"
    (rgb= (rgb-under! (rgb 0.1 0.2 0.3 0.5))
          (rgb 0.1 0.2 0.3 0.5)))

  (test-assert "with many rgb colors"
    (rgb-near? (rgb-under! (rgb 0.8 0.6 0.4 0.4)
                           (rgb 0.4 0.5 0.6 0.5)
                           (rgb 0.7 0.8 0.9 0.6)
                           (rgb 0.5 0.4 0.3 0.7)
                           (rgb 0.7 0.5 0.2 0.8))
               (rgb 0.669 0.497 0.245 0.993)
               1e-3))

  (test-assert "with many assorted colors"
    (rgb= (rgb-under! (rgb 0.7 0.8 0.9 0.6)
                      (hsl 10 0.2 0.3 1.0)
                      (rgb8 40 50 60 128)
                      (hsl 50 0.4 0.3 0.7)
                      (rgb8 20 10 0 180))
          (rgb-under! (rgb 0.7 0.8 0.9 0.6)
                      (hsl->rgb (hsl 10 0.2 0.3 1.0))
                      (rgb8->rgb (rgb8 40 50 60 128))
                      (hsl->rgb (hsl 50 0.4 0.3 0.7))
                      (rgb8->rgb (rgb8 20 10 0 180)))))

  (test-error "with only non-rgb color"
    (rgb-under! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb color first arg"
    (rgb-under! (hsl 70 0.8 0.9 0.6)
                (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "top alpha 1.0"
    (rgb= (rgb-under! (rgb 0.4 0.5 0.6 0.5)
                      (rgb 0.8 0.6 0.4 1.0))
          (rgb 0.8 0.6 0.4 1.0)))

  (test-assert "top alpha 0.0"
    (rgb= (rgb-under! (rgb 0.4 0.5 0.6 0.5)
                      (rgb 0.8 0.6 0.4 0.0))
          (rgb 0.4 0.5 0.6 0.5)))

  (test-error (rgb-under!))

  (test-error (rgb-under! '(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-under! #u8(1 2 3 4) (rgb 0.3 0.4 0.5 0.6)))
  (test-error (rgb-under! #f32(0.1 0.2 0.3 0.4) (rgb 0.3 0.4 0.5 0.6)))

  (test-error (rgb-under! (rgb 0.3 0.4 0.5 0.6) '(1 2 3 4)))
  (test-error (rgb-under! (rgb 0.3 0.4 0.5 0.6) #u8(1 2 3 4)))
  (test-error (rgb-under! (rgb 0.3 0.4 0.5 0.6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-under"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 0.2))
         (result (rgb8-under c1 c2 c3)))
    (test-assert "returns expected result"
      (rgb8= result (rgb8 197 197 153 214)))
    (test-assert "does not modify arguments"
      (and (rgb8= c1 (rgb8 240 250 160 128))
           (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 0.2))))
    (test-assert "returns a new object"
      (and (not (eq? result c1))
           (not (eq? result c2))
           (not (eq? result c3)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-under (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-under (rgb8 210 220 230 100)
                       (rgb8 40 50 60 50)
                       (rgb8 70 80 90 60)
                       (rgb8 50 40 30 70)
                       (rgb8 20 10 00 80))
           (rgb8 63 60 58 206)))

  (test-assert "with 1 non-rgb8 color"
    (rgb8= (rgb8-under (rgb 0.1 0.2 0.3 1.0))
           (rgb->rgb8 (rgb 0.1 0.2 0.3 1.0))))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-under (rgb8 230 240 250 160)
                       (rgb 0.5 0.4 0.8 0.5)
                       (hsl 40 0.5 0.6 0.5)
                       (rgb 0.5 0.4 0.7 0.7)
                       (hsl 20 0.3 0.5 0.9))
           (rgb8-under (rgb8 230 240 250 160)
                       (rgb->rgb8 (rgb 0.5 0.4 0.8 0.5))
                       (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                       (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                       (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-assert "top alpha 255"
    (rgb8= (rgb8-under (rgb8 40 50 60 50)
                       (rgb8 210 220 230 255))
           (rgb8 210 220 230 255)))

  (test-assert "top alpha 0"
    (rgb8= (rgb8-under (rgb8 40 50 60 50)
                       (rgb8 210 220 230 0))
           (rgb8 40 50 60 50)))

  (test-error (rgb8-under))

  (test-error (rgb8-under '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-under #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-under #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-under (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-under (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-under (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))


(test-group "rgb8-under!"
  (let* ((c1 (rgb8 240 250 160 128))
         (c2 (hsl 70 0.8 0.9 0.6))
         (c3 (rgb 0.5 0.4 0.3 0.2))
         (result (rgb8-under! c1 c2 c3)))
    (test-assert "returns the first argument"
      (eq? result c1))
    (test-assert "modifies first argument"
      (rgb8= c1 (rgb8 197 197 153 214)))
    (test-assert "does not modify other arguments"
      (and (hsl= c2 (hsl 70 0.8 0.9 0.6))
           (rgb= c3 (rgb 0.5 0.4 0.3 0.2)))))

  (test-assert "with 1 rgb8 color"
    (rgb8= (rgb8-under! (rgb8 10 20 30 255))
           (rgb8 10 20 30 255)))

  (test-assert "with many rgb8 colors"
    (rgb8= (rgb8-under (rgb8 210 220 230 100)
                       (rgb8 40 50 60 50)
                       (rgb8 70 80 90 60)
                       (rgb8 50 40 30 70)
                       (rgb8 20 10 00 80))
           (rgb8 63 60 58 206)))

  (test-assert "with many assorted colors"
    (rgb8= (rgb8-under! (rgb8 230 240 250 160)
                        (rgb 0.5 0.4 0.8 0.5)
                        (hsl 40 0.5 0.6 0.5)
                        (rgb 0.5 0.4 0.7 0.7)
                        (hsl 20 0.3 0.5 0.9))
           (rgb8-under! (rgb8 230 240 250 160)
                        (rgb->rgb8 (rgb 0.5 0.4 0.8 0.5))
                        (hsl->rgb8 (hsl 40 0.5 0.6 0.5))
                        (rgb->rgb8 (rgb 0.5 0.4 0.7 0.7))
                        (hsl->rgb8 (hsl 20 0.3 0.5 0.9)))))

  (test-error "with only non-rgb8 color"
    (rgb8-under! (hsl 10 0.2 0.3 1.0)))

  (test-error "with non-rgb8 color first arg"
    (rgb8-under! (hsl 70 0.8 0.9 0.6)
                 (rgb 0.1 0.2 0.3 1.0)))

  (test-assert "top alpha 255"
    (rgb8= (rgb8-under! (rgb8 40 50 60 50)
                        (rgb8 210 220 230 255))
           (rgb8 210 220 230 255)))

  (test-assert "top alpha 0"
    (rgb8= (rgb8-under! (rgb8 40 50 60 50)
                        (rgb8 210 220 230 0))
           (rgb8 40 50 60 50)))

  (test-error (rgb8-under!))

  (test-error (rgb8-under! '(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-under! #u8(1 2 3 4) (rgb8 3 4 5 6)))
  (test-error (rgb8-under! #f32(0.1 0.2 0.3 0.4) (rgb8 3 4 5 6)))

  (test-error (rgb8-under! (rgb8 3 4 5 6) '(1 2 3 4)))
  (test-error (rgb8-under! (rgb8 3 4 5 6) #u8(1 2 3 4)))
  (test-error (rgb8-under! (rgb8 3 4 5 6) #f32(0.1 0.2 0.3 0.4))))