(test-group "sdl2:make-color"
  (test-assert (sdl2:color? (sdl2:make-color)))
  (test 0 (sdl2:color-r (sdl2:make-color)))
  (test 0 (sdl2:color-g (sdl2:make-color)))
  (test 0 (sdl2:color-b (sdl2:make-color)))
  (test 255 (sdl2:color-a (sdl2:make-color)))

  (test-assert (sdl2:color? (sdl2:make-color 1)))
  (test 1 (sdl2:color-r (sdl2:make-color 1)))
  (test 0 (sdl2:color-g (sdl2:make-color 1)))
  (test 0 (sdl2:color-b (sdl2:make-color 1)))
  (test 255 (sdl2:color-a (sdl2:make-color 1)))

  (test-assert (sdl2:color? (sdl2:make-color 1 2 3 4)))
  (test 1 (sdl2:color-r (sdl2:make-color 1 2 3 4)))
  (test 2 (sdl2:color-g (sdl2:make-color 1 2 3 4)))
  (test 3 (sdl2:color-b (sdl2:make-color 1 2 3 4)))
  (test 4 (sdl2:color-a (sdl2:make-color 1 2 3 4)))

  ;; Inexact integers
  (test-assert (sdl2:color? (sdl2:make-color 1.0 2.0 3.0 4.0)))
  (test 1 (sdl2:color-r (sdl2:make-color 1.0 2.0 3.0 4.0)))
  (test 2 (sdl2:color-g (sdl2:make-color 1.0 2.0 3.0 4.0)))
  (test 3 (sdl2:color-b (sdl2:make-color 1.0 2.0 3.0 4.0)))
  (test 4 (sdl2:color-a (sdl2:make-color 1.0 2.0 3.0 4.0))))


(test-group "sdl2:color?"
  (test-assert (sdl2:color? (sdl2:make-color)))
  (test-assert (sdl2:color? (sdl2:make-color 1 2 3 4)))
  (test-assert (not (sdl2:color? '(1 2 3 4))))
  (test-assert (not (sdl2:color? #(1 2 3 4))))
  (test-assert (not (sdl2:color? (sdl2:make-point)))))


(test-integer-struct-fields
 make: (sdl2:make-color)
 freer: sdl2:free-color!
 (x
  getter: sdl2:color-r
  setter: sdl2:color-r-set!
  min: Uint8-min
  max: Uint8-max)
 (y
  getter: sdl2:color-g
  setter: sdl2:color-g-set!
  min: Uint8-min
  max: Uint8-max)
 (w
  getter: sdl2:color-b
  setter: sdl2:color-b-set!
  min: Uint8-min
  max: Uint8-max)
 (h
  getter: sdl2:color-a
  setter: sdl2:color-a-set!
  min: Uint8-min
  max: Uint8-max))


(test-group "sdl2:color-set!"
  (let ((color (sdl2:make-color)))
    (test-assert "returns the color"
                 (eq? color (sdl2:color-set! color 5 6 7 8))))
  (test "sets all fields if all values are specified"
        '(5 6 7 8)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4) 5 6 7 8)))
  (test "accepts inexact integers"
        '(5 6 7 8)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4)
                          5.0 6.0 7.0 8.0)))
  (test "does not change fields where the value is omitted"
        '(5 6 3 4)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4) 5 6)))
  (test "has no effect if all values are omitted"
        '(1 2 3 4)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4))))
  (test "does not change fields where the value is #f"
        '(1 8 3 9)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4) #f 8 #f 9)))
  (test "has no effect if all values are #f"
        '(1 2 3 4)
        (sdl2:color->list
         (sdl2:color-set! (sdl2:make-color 1 2 3 4) #f #f #f #f))))


(test-group "sdl2:free-color!"
  (let ((color (sdl2:make-color)))
    (sdl2:free-color! color)
    (test-assert "sets the record's pointer to null"
                 (sdl2:struct-null? color)))

  (let ((color (sdl2:make-color)))
    (test-assert "returns the same instance"
                 (eq? color (sdl2:free-color! color)))
    (test-assert "is safe to use multiple times on the same color"
                 (eq? color (sdl2:free-color! color))))

  (test-error (sdl2:free-color! 0))
  (test-error (sdl2:free-color! #f))
  (test-error (sdl2:free-color! '(1 2 3 4)))
  (test-error (sdl2:free-color! (sdl2:make-point))))


(test-group "sdl2:color-copy"
  (test "Returns a different sdl2:color with the same values"
        (list #t '(1 2 3 4))
        (let* ((a (sdl2:make-color 1 2 3 4))
               (result (sdl2:color-copy a)))
          (list (not (equal? a result))
                (sdl2:color->list result)))))

(test-group "sdl2:color-copy!"
  (test "Modifies and returns the destination color"
        (list #t '(1 2 3 4))
        (let* ((a (sdl2:make-color 1 2 3 4))
               (b (sdl2:make-color 5 6 7 8))
               (result (sdl2:color-copy! a b)))
          (list (eq? b result)
                (sdl2:color->list b)))))



(test-group "sdl2:color-scale!"
  (test "Can scale the color by an exact integer"
        '(0 36 30 54)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 6 5 9) 6)))

  (test "Can scale the color by an inexact integer"
        '(0 36 30 54)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 6 5 9) 6.0)))

  (test "Caps at 255 if given large integer scale"
        '(0 254 255 255)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) 254)))

  (test "Caps at 255 if given very large integer scale"
        '(0 255 255 255)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) 123456789)))

  (test "Floors at 0 if given negative integer scale"
        '(0 0 0 0)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) -1)))

  (test "Can scale the color by a float (truncates)"
        '(0 39 33 59)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 6 5 9) 6.6)))

  (test "Can scale the color by a float less than 1.0 (truncates)"
        '(0 57 115 229)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 64 128 255) 0.9)))

  (test "Caps at 255 if given large float scale"
        '(0 254 255 255)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) 254.5)))

  (test "Caps at 255 if given very large float scale"
        '(0 255 255 255)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) 12345678.9)))

  (test "Floors at 0 if given negative float scale"
        '(0 0 0 0)
        (sdl2:color->list
         (sdl2:color-scale! (sdl2:make-color 0 1 2 3) -1.5)))

  (test-assert "Modifies and returns the same color by default"
    (let ((c (sdl2:make-color 0 6 5 9)))
      (eq? c (sdl2:color-scale! c 6.6))))

  (test "Modifies and returns the given dest color"
        (list #t '(0 39 33 59))
        (let ((c (sdl2:make-color 0 6 5 9))
              (dest (sdl2:make-color 12 34 56 78)))
          (list (eq? dest (sdl2:color-scale! c 6.6 dest))
                (sdl2:color->list dest)))))


(test-group "sdl2:color-scale"
  (test "Returns a new color without modifying the original"
        '((0 36 30 54)
          (0 6 5 9))
        (let* ((c (sdl2:make-color 0 6 5 9))
               (result (sdl2:color-scale c 6)))
          (list (sdl2:color->list result)
                (sdl2:color->list c)))))



(test-group "sdl2:color-mult!"
  (test "Color-multiplies the RGB of c2 with c1, if c2 alpha is 255"
        '(0 17 56 78)
        (let ((c1 (sdl2:make-color 12  34  56  78))
              (c2 (sdl2:make-color  0 128 255 255)))
          (sdl2:color->list
           (sdl2:color-mult! c1 c2))))

  (test "Uses c1 values, if c2 alpha is 0"
        '(12 34 56 78)
        (let ((c1 (sdl2:make-color 12  34  56 78))
              (c2 (sdl2:make-color  0 128 255  0)))
          (sdl2:color->list
           (sdl2:color-mult! c1 c2))))

  (test "Partially multiplies c2, if c2 alpha is between 0 and 255"
        '(6 26 56 78)
        (let ((c1 (sdl2:make-color 12  34  56  78))
              (c2 (sdl2:make-color  0 128 255 128)))
          (sdl2:color->list
           (sdl2:color-mult! c1 c2))))

  (test-assert "Modifies and returns c1 by default"
    (let ((c1 (sdl2:make-color 12  34  56 78))
          (c2 (sdl2:make-color  0 128 255  0)))
      (eq? c1 (sdl2:color-mult! c1 c2))))

  (test "Modifies and returns the given dest color"
        (list #t '(0 17 56 78))
        (let ((c1 (sdl2:make-color 12  34  56  78))
              (c2 (sdl2:make-color  0 128 255 255))
              (dest (sdl2:make-color 0 0 0 0)))
          (list (eq? dest (sdl2:color-mult! c1 c2 dest))
                (sdl2:color->list dest)))))


(test-group "sdl2:color-mult"
  (test "Returns a new color without modifying the originals"
        '((12  34  56  78)
          ( 0 128 255 255)
          ( 0  17  56  78))
        (let* ((c1 (sdl2:make-color 12  34  56  78))
               (c2 (sdl2:make-color  0 128 255 255))
               (result (sdl2:color-mult c1 c2)))
          (list (sdl2:color->list c1)
                (sdl2:color->list c2)
                (sdl2:color->list result)))))



(test-group "sdl2:color-add!"
  (test "Adds the RGB of c2 to c1, if c2 alpha is 255"
        '(76 162 255 78)
        (let ((c1 (sdl2:make-color 12  34  56 78))
              (c2 (sdl2:make-color 64 128 200 255)))
          (sdl2:color->list
           (sdl2:color-add! c1 c2))))

  (test "Uses c1 values, if c2 alpha is 0"
        '(12 34 56 78)
        (let ((c1 (sdl2:make-color 12  34  56 78))
              (c2 (sdl2:make-color 64 128 200 0)))
          (sdl2:color->list
           (sdl2:color-add! c1 c2))))

  (test "Partially adds c2, if c2 alpha is between 0 and 255"
        '(44 98 156 78)
        (let ((c1 (sdl2:make-color 12  34  56 78))
              (c2 (sdl2:make-color 64 128 200 128)))
          (sdl2:color->list
           (sdl2:color-add! c1 c2))))

  (test-assert "Modifies and returns c1 by default"
    (let ((c1 (sdl2:make-color 12  34  56 78))
          (c2 (sdl2:make-color 64 128 200 0)))
      (eq? c1 (sdl2:color-add! c1 c2))))

  (test "Modifies and returns the given dest color"
        (list #t '(76 162 255 78))
        (let ((c1 (sdl2:make-color 12  34  56 78))
              (c2 (sdl2:make-color 64 128 200 255))
              (dest (sdl2:make-color 0 0 0 0)))
          (list (eq? dest (sdl2:color-add! c1 c2 dest))
                (sdl2:color->list dest)))))


(test-group "sdl2:color-add"
  (test "Returns a new color without modifying the originals"
        '((12  34  56  78)
          (64 128 200 255)
          (76 162 255  78))
        (let* ((c1 (sdl2:make-color 12  34  56  78))
               (c2 (sdl2:make-color 64 128 200 255))
               (result (sdl2:color-add c1 c2)))
          (list (sdl2:color->list c1)
                (sdl2:color->list c2)
                (sdl2:color->list result)))))



(test-group "sdl2:color-sub!"
  (test "Subtracts the RGB of c2 from c1, if c2 alpha is 255"
        '(52 94 0 96)
        (let ((c1 (sdl2:make-color 64 128 200  96))
              (c2 (sdl2:make-color 12  34 255 255)))
          (sdl2:color->list
           (sdl2:color-sub! c1 c2))))

  (test "Uses c1 values, if c2 alpha is 0"
        '(64 128 200 96)
        (let ((c1 (sdl2:make-color 64 128 200 96))
              (c2 (sdl2:make-color 12  34 255  0)))
          (sdl2:color->list
           (sdl2:color-sub! c1 c2))))

  (test "Partially subtracts c2, if c2 alpha is between 0 and 255"
        '(58 111 72 96)
        (let ((c1 (sdl2:make-color 64 128 200  96))
              (c2 (sdl2:make-color 12  34 255 128)))
          (sdl2:color->list
           (sdl2:color-sub! c1 c2))))

  (test-assert "Modifies and returns c1 by default"
    (let ((c1 (sdl2:make-color 64 128 200  96))
          (c2 (sdl2:make-color 12  34  56 255)))
      (eq? c1 (sdl2:color-sub! c1 c2))))

  (test "Modifies and returns the given dest color"
        (list #t '(52 94 0 96))
        (let ((c1 (sdl2:make-color 64 128 200  96))
              (c2 (sdl2:make-color 12  34 255 255))
              (dest (sdl2:make-color 0 0 0 0)))
          (list (eq? dest (sdl2:color-sub! c1 c2 dest))
                (sdl2:color->list dest)))))


(test-group "sdl2:color-sub"
  (test "Returns a new color without modifying the originals"
        '((64 128 200  96)
          (12  34 255 255)
          (52  94   0  96))
        (let* ((c1 (sdl2:make-color 64 128 200  96))
               (c2 (sdl2:make-color 12  34 255 255))
               (result (sdl2:color-sub c1 c2)))
          (list (sdl2:color->list c1)
                (sdl2:color->list c2)
                (sdl2:color->list result)))))



(test-group "sdl2:color-lerp!"
  (test "t between 0 and 1 interpolates between the colors"
        '(33 67 29 51)
        (sdl2:color->list
         (sdl2:color-lerp! (sdl2:make-color 25 61 21 43)
                           (sdl2:make-color 60 85 56 78)
                           0.25)))

  (test "t = 0 results in same as first color"
        '(25 61 21 43)
        (sdl2:color->list
         (sdl2:color-lerp! (sdl2:make-color 25 61 21 43)
                           (sdl2:make-color 60 85 56 78)
                           0)))

  (test "t = 1 results in same as second color"
        '(60 85 56 78)
        (sdl2:color->list
         (sdl2:color-lerp! (sdl2:make-color 25 61 21 43)
                           (sdl2:make-color 60 85 56 78)
                           1)))

  (test "t < 0 extrapolates beyond the first color"
        '(7 49 3 25)
        (sdl2:color->list
         (sdl2:color-lerp! (sdl2:make-color 25 61 21 43)
                           (sdl2:make-color 60 85 56 78)
                           -0.5)))

  (test "t > 1 extrapolates beyond the second color"
        '(95 109 91 113)
        (sdl2:color->list
         (sdl2:color-lerp! (sdl2:make-color 25 61 21 43)
                           (sdl2:make-color 60 85 56 78)
                           2)))

  (test-assert "Modifies and returns the first color by default"
    (let ((r1 (sdl2:make-color 25 61 21 43))
          (r2 (sdl2:make-color 60 85 56 78)))
      (eq? r1 (sdl2:color-lerp! r1 r2 0.25))))

  (test "Modifies and returns the given dest color"
        (list #t '(33 67 29 51))
        (let ((r1 (sdl2:make-color 25 61 21 43))
              (r2 (sdl2:make-color 60 85 56 78))
              (dest (sdl2:make-color 12 34 56 78)))
          (list (eq? dest (sdl2:color-lerp! r1 r2 0.25 dest))
                (sdl2:color->list dest)))))


(test-group "sdl2:color-lerp"
  (test "Returns a new color without modifying the originals"
        '((25 61 21 43)
          (60 85 56 78)
          (33 67 29 51))
        (let* ((r1 (sdl2:make-color 25 61 21 43))
               (r2 (sdl2:make-color 60 85 56 78))
               (result (sdl2:color-lerp r1 r2 0.25)))
          (list (sdl2:color->list r1)
                (sdl2:color->list r2)
                (sdl2:color->list result)))))



(test-group "aliases"
  (test-assert (eq? sdl2:colour?       sdl2:color?))
  (test-assert (eq? sdl2:free-colour!  sdl2:free-color!))
  (test-assert (eq? sdl2:colour-r      sdl2:color-r))
  (test-assert (eq? sdl2:colour-g      sdl2:color-g))
  (test-assert (eq? sdl2:colour-b      sdl2:color-b))
  (test-assert (eq? sdl2:colour-a      sdl2:color-a))
  (test-assert (eq? sdl2:colour-r-set! sdl2:color-r-set!))
  (test-assert (eq? sdl2:colour-g-set! sdl2:color-g-set!))
  (test-assert (eq? sdl2:colour-b-set! sdl2:color-b-set!))
  (test-assert (eq? sdl2:colour-a-set! sdl2:color-a-set!))
  (test-assert (eq? sdl2:make-colour   sdl2:make-color))
  (test-assert (eq? sdl2:colour-set!   sdl2:color-set!))
  (test-assert (eq? sdl2:colour->list  sdl2:color->list))
  (test-assert (eq? sdl2:colour->values  sdl2:color->values))
  (test-assert (eq? sdl2:colour-copy!  sdl2:color-copy!))
  (test-assert (eq? sdl2:colour-copy   sdl2:color-copy))
  (test-assert (eq? sdl2:copy-colour   sdl2:copy-color))
  (test-assert (eq? sdl2:copy-colour*  sdl2:copy-color*))
  (test-assert (eq? sdl2:colour-scale! sdl2:color-scale!))
  (test-assert (eq? sdl2:colour-scale  sdl2:color-scale))
  (test-assert (eq? sdl2:colour-mult!  sdl2:color-mult!))
  (test-assert (eq? sdl2:colour-mult   sdl2:color-mult))
  (test-assert (eq? sdl2:colour-add!   sdl2:color-add!))
  (test-assert (eq? sdl2:colour-add    sdl2:color-add))
  (test-assert (eq? sdl2:colour-sub!   sdl2:color-sub!))
  (test-assert (eq? sdl2:colour-sub    sdl2:color-sub))
  (test-assert (eq? sdl2:colour-lerp!  sdl2:color-lerp!))
  (test-assert (eq? sdl2:colour-lerp   sdl2:color-lerp))

  ;; Test that the field getters can be set.
  (let ((colour (sdl2:make-colour 1 2 3 4)))
    (set! (sdl2:colour-r colour) 5)
    (set! (sdl2:colour-g colour) 6)
    (set! (sdl2:colour-b colour) 7)
    (set! (sdl2:colour-a colour) 8)
    (test '(5 6 7 8) (sdl2:colour->list colour))))