(test-group "rgb8 constructor"
  (define (do-test r g b a)
    (let ((c (rgb8 r g b a)))
      (test-assert (sprintf "(rgb8 ~A ~A ~A ~A)" r g b a)
        (and (rgb8? c)
             (= r (rgb8-r c))
             (= g (rgb8-g c))
             (= b (rgb8-b c))
             (= a (rgb8-a c))))))
  (do-test 0 0 0 0)
  (do-test 1 2 3 4)
  (do-test 255 255 255 255)

  (test #f (rgb8-parent (rgb8 1 2 3 4)))

  (test-error (rgb8))
  (test-error (rgb8 1))
  (test-error (rgb8 1 2))
  (test 255 (rgb8-a (rgb8 1 2 3)))

  (test-error (rgb8 1.5 0 0 0))
  (test-error (rgb8 0 1.5 0 0))
  (test-error (rgb8 0 0 1.5 0))
  (test-error (rgb8 0 0 0 1.5))
  (test-error (rgb8 -1 0 0 0))
  (test-error (rgb8 0 -1 0 0))
  (test-error (rgb8 0 0 -1 0))
  (test-error (rgb8 0 0 0 -1))
  (test-error (rgb8 256 0 0 0))
  (test-error (rgb8 0 256 0 0))
  (test-error (rgb8 0 0 256 0))
  (test-error (rgb8 0 0 0 256)))


(test-group "rgb8 setters"
  ;; Setters
  (let ((c (rgb8 1 2 3 4)))
    (test c (rgb8-r-set! c 21))
    (test-assert (rgb8= (rgb8 21 2 3 4) c))
    (test c (rgb8-g-set! c 43))
    (test-assert (rgb8= (rgb8 21 43 3 4) c))
    (test c (rgb8-b-set! c 65))
    (test-assert (rgb8= (rgb8 21 43 65 4) c))
    (test c (rgb8-a-set! c 87))
    (test-assert (rgb8= (rgb8 21 43 65 87) c))

    (test-error (rgb8-r-set! c -1))
    (test-error (rgb8-r-set! c 256))
    (test-error (rgb8-g-set! c -1))
    (test-error (rgb8-g-set! c 256))
    (test-error (rgb8-b-set! c -1))
    (test-error (rgb8-b-set! c 256))
    (test-error (rgb8-a-set! c -1))
    (test-error (rgb8-a-set! c 256)))

  ;; set! with getters
  (let ((c (rgb8 1 2 3 4)))
    (test c (set! (rgb8-r c) 21))
    (test-assert (rgb8= (rgb8 21 2 3 4) c))
    (test c (set! (rgb8-g c) 43))
    (test-assert (rgb8= (rgb8 21 43 3 4) c))
    (test c (set! (rgb8-b c) 65))
    (test-assert (rgb8= (rgb8 21 43 65 4) c))
    (test c (set! (rgb8-a c) 87))
    (test-assert (rgb8= (rgb8 21 43 65 87) c))

    (test-error (set! (rgb8-r c) -1))
    (test-error (set! (rgb8-r c) 256))
    (test-error (set! (rgb8-g c) -1))
    (test-error (set! (rgb8-g c) 256))
    (test-error (set! (rgb8-b c) -1))
    (test-error (set! (rgb8-b c) 256))
    (test-error (set! (rgb8-a c) -1))
    (test-error (set! (rgb8-a c) 256))))


(test-group "rgb8?"
  (test-assert (rgb8? (rgb8 1 2 3 4)))
  (test-assert (not (rgb8? '(1 2 3 4))))
  (test-assert (not (rgb8? #(1 2 3 4))))
  (test-assert (not (rgb8? #u8(1 2 3 4))))
  (test-assert (not (rgb8? (rgb 1 2 3 4))))
  (test-assert (not (rgb8? (hsl 1 2 3 4)))))


(test-group "rgb8="
  (test-assert (rgb8= (rgb8 1 2 3 4) (rgb8 1 2 3 4)))
  (test-assert (not (rgb8= (rgb8 0 2 3 4) (rgb8 1 2 3 4))))
  (test-assert (not (rgb8= (rgb8 1 0 3 4) (rgb8 1 2 3 4))))
  (test-assert (not (rgb8= (rgb8 1 2 0 4) (rgb8 1 2 3 4))))
  (test-assert (not (rgb8= (rgb8 1 2 3 0) (rgb8 1 2 3 4))))

  (test-error (rgb8= (rgb8 1 2 3 4) '(1 2 3 4)))
  (test-error (rgb8= '(1 2 3 4) (rgb8 1 2 3 4)))
  (test-error (rgb8= (rgb8 1 2 3 4) (rgb 1 2 3 4)))
  (test-error (rgb8= (rgb 1 2 3 4) (rgb8 1 2 3 4)))
  (test-error (rgb8= (rgb8 1 2 3 4) (hls 1 2 3 4)))
  (test-error (rgb8= (hsl 1 2 3 4) (rgb8 1 2 3 4))))


(test-group "rgb8-copy"
  (let* ((orig (rgb8 1 2 3 4))
         (copy (rgb8-copy orig)))
    ;; copy has same values as orig
    (test-assert (rgb8= copy (rgb8 1 2 3 4)))

    ;; copy and orig do not share memory
    (rgb8-r-set! copy 5)
    (rgb8-g-set! copy 6)
    (rgb8-b-set! copy 7)
    (rgb8-a-set! copy 8)
    (test-assert (rgb8= copy (rgb8 5 6 7 8)))
    (test-assert (rgb8= orig (rgb8 1 2 3 4)))))


(test-group "rgb8-copy!"
  (let ((src (rgb8 1 2 3 4))
        (dst (rgb8 5 6 7 8)))
    (test-assert (rgb8= dst (rgb8 5 6 7 8)))
    (let ((result (rgb8-copy! src dst)))
      ;; dst has been overwritten with src values
      (test-assert (rgb8= dst (rgb8 1 2 3 4)))

      ;; dst and result are the same object
      (test-assert (eq? dst result))
      (rgb8-r-set! result 9)
      (rgb8-g-set! result 8)
      (rgb8-b-set! result 7)
      (rgb8-a-set! result 6)
      (test-assert (rgb8= dst (rgb8 9 8 7 6)))

      ;; src does not share memory with dst
      (test-assert (rgb8= src (rgb8 1 2 3 4))))))


(test-group "rgb8->list"
  (define (do-test r g b a)
    (test (sprintf "(rgb8->list (rgb8 ~A ~A ~A ~A))" r g b a)
          (list r g b a)
          (rgb8->list (rgb8 r g b a))))
  (do-test 0 0 0 0)
  (do-test 1 2 3 4)
  (do-test 255 255 255 255))


(test-group "rgb8-at / rgb8-pointer / rgb8-parent"
  (let ((blob (u8vector->blob #u8(1 2 3 4 5 6))))
    (test-assert (rgb8= (rgb8 1 2 3 4)
                        (rgb8-at (make-locative blob))))
    (test-assert (rgb8= (rgb8 2 3 4 5)
                        (rgb8-at (make-locative blob 1))))
    (test-assert (rgb8= (rgb8 3 4 5 6)
                        (rgb8-at (make-locative blob 2)))))

  (let* ((ptr (allocate 6))
         (c (rgb8-at ptr)))
    (pointer-u8-set! ptr 1)
    (pointer-u8-set! (pointer+ ptr 1) 2)
    (pointer-u8-set! (pointer+ ptr 2) 3)
    (pointer-u8-set! (pointer+ ptr 3) 4)
    (pointer-u8-set! (pointer+ ptr 4) 5)
    (pointer-u8-set! (pointer+ ptr 5) 6)

    (test-assert (pointer=? ptr (rgb8-pointer c)))
    (test-assert (rgb8= c (rgb8 1 2 3 4)))
    (set! (rgb8-pointer c) (pointer+ ptr 1))
    (test-assert (rgb8= c (rgb8 2 3 4 5)))
    (set! (rgb8-pointer c) (pointer+ ptr 2))
    (test-assert (rgb8= c (rgb8 3 4 5 6)))

    (free ptr))

  (test #f (rgb8-parent (rgb8-at (make-locative #u8(1 2 3 4)))))

  (let ((c (rgb8-at (make-locative #u8(1 2 3 4)) 'foo)))
    (test 'foo (rgb8-parent c))
    (set! (rgb8-parent c) 'bar)
    (test 'bar (rgb8-parent c))))


(test-group "rgb8-set!"
  (test-assert "sets every field"
    (let ((c (rgb8 1 2 3 4)))
      (rgb8-set! c 5 6 7 8)
      (rgb8= c (rgb8 5 6 7 8))))
  (test-assert "returns the modified color"
    (let* ((c1 (rgb8 1 2 3 4))
           (c2 (rgb8-set! c1 5 6 7 8)))
      (eq? c1 c2))))


(test-group "rgb8->values"
  (let-values (((r g b a)
                (rgb8->values (rgb8 25 135 175 225))))
    (test (list 25 135 175 225)
          (list r g b a))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; RGB8-ARRAY

(test-group "make-rgb8-array"
  (test-assert (rgb8-array? (make-rgb8-array 1 1 4)))

  (test-assert "default pitch"
    (let ((a (make-rgb8-array 3 5)))
      (and
       (= 3 (rgb8-array-width a))
       (= 5 (rgb8-array-height a))
       (= 12 (rgb8-array-pitch a))
       (= (* 12 5)
          (blob-size (locative->object (rgb8-array-pointer a)))))))

  (test-assert "specified pitch"
    (let ((a (make-rgb8-array 3 5 17)))
      (and
       (= 3 (rgb8-array-width a))
       (= 5 (rgb8-array-height a))
       (= 17 (rgb8-array-pitch a))
       (= (* 17 5)
          (blob-size (locative->object (rgb8-array-pointer a)))))))

  (test-error "zero width" (make-rgb8-array 0 1))
  (test-error "negative width" (make-rgb8-array -1 1))
  (test-error "noninteger width" (make-rgb8-array 1.1 1))

  (test-error "zero height" (make-rgb8-array 1 0))
  (test-error "negative height" (make-rgb8-array 1 -1))
  (test-error "noninteger height" (make-rgb8-array 1 1.1))

  (test-error "too small pitch" (make-rgb8-array 3 5 11))
  (test-error "noninteger pitch" (make-rgb8-array 1 1 4.1)))


(test-group "rgb8-array-at"
  (test-assert
      (rgb8-array?
       (rgb8-array-at (make-locative (make-blob 4))
                      1 1)))

  (test-error "with non-pointerlike"
    (rgb8-array-at (make-blob 4) 1 1))

  (define (do-test ptr)
    (test-assert "default pitch"
      (let ((a (rgb8-array-at ptr 3 5)))
        (and
         (= 3 (rgb8-array-width a))
         (= 5 (rgb8-array-height a))
         (= (* 3 4) (rgb8-array-pitch a))
         (eq? ptr (rgb8-array-pointer a)))))

    (test-assert "specified pitch"
      (let ((a (rgb8-array-at ptr 3 5 42)))
        (and
         (= 3 (rgb8-array-width a))
         (= 5 (rgb8-array-height a))
         (= 42 (rgb8-array-pitch a))
         (eq? ptr (rgb8-array-pointer a)))))

    (test-error "zero width" (rgb8-array-at ptr 0 1))
    (test-error "negative width" (rgb8-array-at ptr -1 1))
    (test-error "noninteger width" (rgb8-array-at ptr 1.1 1))

    (test-error "zero height" (rgb8-array-at ptr 1 0))
    (test-error "negative height" (rgb8-array-at ptr 1 -1))
    (test-error "noninteger height" (rgb8-array-at ptr 1 1.1))

    (test-error "too small pitch" (rgb8-array-at ptr 3 5 11))
    (test-error "noninteger pitch" (rgb8-array-at ptr 1 1 4.1)))

  (test-group "with locative"
    (do-test (make-locative (make-blob (* 12 5)))))

  (test-group "with pointer"
    (let ((mem (allocate (* 12 5))))
      (do-test mem)
      (free mem))))


(test-group "rgb8-array-parent"
  (let ((a (make-rgb8-array 1 1)))
    (test #f (rgb8-array-parent a))
    (set! (rgb8-array-parent a) 'parent)
    (test 'parent (rgb8-array-parent a)))

  (let ((a (rgb8-array-at (make-locative (make-blob 4)) 1 1)))
    (test #f (rgb8-array-parent a))
    (set! (rgb8-array-parent a) 'parent)
    (test 'parent (rgb8-array-parent a))))


(test-group "rgb8-array-ref"
  (test-group "with locative"
    (define data (u8vector 01 02 03 04 05 06 07 08 09 10
                           11 12 13 14 15 16 17 18 19 20))
    (define a (rgb8-array-at (make-locative data) 2 2 10))

    (test-assert (rgb8= (rgb8 01 02 03 04) (rgb8-array-ref a 0 0)))
    (test-assert (rgb8= (rgb8 05 06 07 08) (rgb8-array-ref a 1 0)))
    (test-assert (rgb8= (rgb8 11 12 13 14) (rgb8-array-ref a 0 1)))
    (test-assert (rgb8= (rgb8 15 16 17 18) (rgb8-array-ref a 1 1)))

    (test a (rgb8-parent (rgb8-array-ref a 0 0)))

    (rgb8-set! (rgb8-array-ref a 1 0) 71 72 73 74)
    (rgb8-set! (rgb8-array-ref a 0 1) 91 92 93 94)
    (test "modifying color affects underlying memory"
          data
          (u8vector 01 02 03 04 71 72 73 74 09 10
                    91 92 93 94 15 16 17 18 19 20)))

  (test-group "with pointer"
    (define data
      (let ((data (allocate 20)))
        (for-each (lambda (i)
                    (pointer-u8-set! (pointer+ data i) (add1 i)))
                  (iota 20))
        data))
    (define a (rgb8-array-at data 2 2 10))

    (test-assert (rgb8= (rgb8 01 02 03 04) (rgb8-array-ref a 0 0)))
    (test-assert (rgb8= (rgb8 05 06 07 08) (rgb8-array-ref a 1 0)))
    (test-assert (rgb8= (rgb8 11 12 13 14) (rgb8-array-ref a 0 1)))
    (test-assert (rgb8= (rgb8 15 16 17 18) (rgb8-array-ref a 1 1)))

    (test a (rgb8-parent (rgb8-array-ref a 0 0)))

    (rgb8-set! (rgb8-array-ref a 1 0) 71 72 73 74)
    (rgb8-set! (rgb8-array-ref a 0 1) 91 92 93 94)
    (test "modifying color affects underlying memory"
          (list 01 02 03 04 71 72 73 74 09 10
                91 92 93 94 15 16 17 18 19 20)
          (map (lambda (i) (pointer-u8-ref (pointer+ data i)))
               (iota 20)))

    (free data)))


(test-group "rgb8-array-ref-pointer"
  (test-group "with locative"
    (define data (u8vector 01 02 03 04 05 06 07 08 09 10
                           11 12 13 14 15 16 17 18 19 20))
    (define a (rgb8-array-at (make-locative data) 2 2 10))

    (test (locative->object (make-locative data (+ 10 4)))
          (locative->object (rgb8-array-ref-pointer a 1 1)))

    (test-assert (rgb8= (rgb8 01 02 03 04)
                        (rgb8-at (rgb8-array-ref-pointer a 0 0))))
    (test-assert (rgb8= (rgb8 05 06 07 08)
                        (rgb8-at (rgb8-array-ref-pointer a 1 0))))
    (test-assert (rgb8= (rgb8 11 12 13 14)
                        (rgb8-at (rgb8-array-ref-pointer a 0 1))))
    (test-assert (rgb8= (rgb8 15 16 17 18)
                        (rgb8-at (rgb8-array-ref-pointer a 1 1))))

    (rgb8-set! (rgb8-at (rgb8-array-ref-pointer a 1 0)) 71 72 73 74)
    (rgb8-set! (rgb8-at (rgb8-array-ref-pointer a 0 1)) 91 92 93 94)
    (test "modifying color affects underlying memory"
          data
          (u8vector 01 02 03 04 71 72 73 74 09 10
                    91 92 93 94 15 16 17 18 19 20)))

  (test-group "with pointer"
    (define data
      (let ((data (allocate 20)))
        (for-each (lambda (i)
                    (pointer-u8-set! (pointer+ data i) (add1 i)))
                  (iota 20))
        data))
    (define a (rgb8-array-at data 2 2 10))

    (test (pointer+ data (+ 10 4))
          (rgb8-array-ref-pointer a 1 1))

    (test-assert (rgb8= (rgb8 01 02 03 04)
                        (rgb8-at (rgb8-array-ref-pointer a 0 0))))
    (test-assert (rgb8= (rgb8 05 06 07 08)
                        (rgb8-at (rgb8-array-ref-pointer a 1 0))))
    (test-assert (rgb8= (rgb8 11 12 13 14)
                        (rgb8-at (rgb8-array-ref-pointer a 0 1))))
    (test-assert (rgb8= (rgb8 15 16 17 18)
                        (rgb8-at (rgb8-array-ref-pointer a 1 1))))

    (rgb8-set! (rgb8-at (rgb8-array-ref-pointer a 1 0)) 71 72 73 74)
    (rgb8-set! (rgb8-at (rgb8-array-ref-pointer a 0 1)) 91 92 93 94)
    (test "modifying color affects underlying memory"
          (list 01 02 03 04 71 72 73 74 09 10
                91 92 93 94 15 16 17 18 19 20)
          (map (lambda (i) (pointer-u8-ref (pointer+ data i)))
               (iota 20)))

    (free data)))


(test-group "rgb8-array-for-each"
  (define data1 (make-u8vector (* 3 2 4)))
  (define data2 (make-u8vector (* 2 3 4)))
  (define a1 (rgb8-array-at (make-locative data1) 2 2 10))
  (define a2 (rgb8-array-at (make-locative data2) 2 3 10))

  (let ((result '()))
    (rgb8-array-for-each
     (lambda args (set! result (cons args result)))
     a1 a2)

    (test "calls function with correct arguments in correct order"
          `((0 0 ,(rgb8-array-ref a1 0 0) ,(rgb8-array-ref a2 0 0))
            (1 0 ,(rgb8-array-ref a1 1 0) ,(rgb8-array-ref a2 1 0))
            (0 1 ,(rgb8-array-ref a1 0 1) ,(rgb8-array-ref a2 0 1))
            (1 1 ,(rgb8-array-ref a1 1 1) ,(rgb8-array-ref a2 1 1)))
          (reverse result))))


(test-group "rgb8-array-for-each"
  (define data1 (make-u8vector (* 3 2 4)))
  (define data2 (make-u8vector (* 2 3 4)))
  (define a1 (rgb8-array-at (make-locative data1) 2 2 10))
  (define a2 (rgb8-array-at (make-locative data2) 2 3 10))

  (let ((result '()))
    (rgb8-array-for-each-pointer
     (lambda args (set! result (cons args result)))
     a1 a2)

    (test "calls function with correct arguments in correct order"
          `((0 0
               ,(rgb8-array-ref-pointer a1 0 0)
               ,(rgb8-array-ref-pointer a2 0 0))
            (1 0
               ,(rgb8-array-ref-pointer a1 1 0)
               ,(rgb8-array-ref-pointer a2 1 0))
            (0 1
               ,(rgb8-array-ref-pointer a1 0 1)
               ,(rgb8-array-ref-pointer a2 0 1))
            (1 1
               ,(rgb8-array-ref-pointer a1 1 1)
               ,(rgb8-array-ref-pointer a2 1 1)))
          (reverse result))))