;;;
;;; macaw:
;;; Efficient color types and math for CHICKEN Scheme.
;;;
;;; Copyright © 2020  John Croisant.
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;;  * Redistributions of source code must retain the above copyright
;;;    notice, this list of conditions and the following disclaimer.
;;;
;;;  * Redistributions in binary form must reproduce the above
;;;    copyright notice, this list of conditions and the following
;;;    disclaimer in the documentation and/or other materials provided
;;;    with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
;;; TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
;;; THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.


(export rgb8 rgb8? rgb8= rgb8-set!
        rgb8->values rgb8->list
        rgb8-copy rgb8-copy!
        rgb8-at rgb8-pointer rgb8-parent
        rgb8-r rgb8-r-set!
        rgb8-g rgb8-g-set!
        rgb8-b rgb8-b-set!
        rgb8-a rgb8-a-set!

        rgb8-array? make-rgb8-array
        rgb8-array-at rgb8-array-pointer rgb8-array-parent
        rgb8-array-width rgb8-array-height rgb8-array-pitch
        rgb8-array-ref rgb8-array-ref-pointer
        rgb8-array-for-each rgb8-array-for-each-pointer)


(define-color-type macaw:rgb8
  rgb8 rgb8? rgb8= rgb8-set!
  rgb8->values rgb8->list
  rgb8-copy rgb8-copy!
  ((r 0 rgb8-r rgb8-r-set! fixnum min: 0 max: 255)
   (g 1 rgb8-g rgb8-g-set! fixnum min: 0 max: 255)
   (b 2 rgb8-b rgb8-b-set! fixnum min: 0 max: 255)
   (a 3 rgb8-a rgb8-a-set! fixnum min: 0 max: 255 default: 255))
  memory: (rgb8-at %rgb8-at rgb8-pointer rgb8-parent
                   u8vector unsigned-byte
                   u8color-set! u8color->values))

(define-array-type macaw:rgb8-array
  rgb8-array rgb8-array? make-rgb8-array
  rgb8-array-width rgb8-array-height rgb8-array-pitch
  rgb8-array-ref rgb8-array-ref-pointer
  rgb8-array-for-each rgb8-array-for-each-pointer
  color: (rgb8 rgb8? rgb8-at)
  memory: (rgb8-array-at %rgb8-array-at
                         rgb8-array-pointer rgb8-array-parent
                         bpp: 4))


(define u8color-set!
  (foreign-primitive
   (((nonnull-c-pointer unsigned-byte) color)
    (unsigned-byte x)
    (unsigned-byte y)
    (unsigned-byte z)
    (unsigned-byte a))
   "color[0] = x;"
   "color[1] = y;"
   "color[2] = z;"
   "color[3] = a;"))

(define u8color->values
  (foreign-primitive
   (((const (nonnull-c-pointer unsigned-byte)) color))
   "C_word av[2 + 4] = {"
   "   C_SCHEME_UNDEFINED, C_k,"
   "   C_fix(color[0]),"
   "   C_fix(color[1]),"
   "   C_fix(color[2]),"
   "   C_fix(color[3])"
   "};"
   "C_values(2 + 4, av);"))