;;
;; chicken-sdl2: CHICKEN Scheme bindings to Simple DirectMedia Layer 2
;;
;; Copyright © 2013–2021  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 render-draw-blend-mode  render-draw-blend-mode-set!
        render-draw-blend-mode-raw
        render-draw-color       render-draw-color-set!
        render-draw-colour      render-draw-colour-set!

        render-clear!
        render-draw-line!       render-draw-lines!
        render-draw-point!      render-draw-points!
        render-draw-rect!       render-draw-rects!
        render-fill-rect!       render-fill-rects!)


(: render-draw-blend-mode
   (sdl2:renderer* -> (or symbol integer)))
(define (render-draw-blend-mode renderer)
  (blend-mode->symbol (render-draw-blend-mode-raw renderer)
                      identity))

(: render-draw-blend-mode-raw
   (sdl2:renderer* -> integer))
(define (render-draw-blend-mode-raw renderer)
  (with-temp-mem ((mode-out (%allocate-Uint8)))
    (try-call (SDL_GetRenderDrawBlendMode renderer mode-out)
              on-fail: (free mode-out))
    (pointer-u8-ref mode-out)))


(: render-draw-blend-mode-set!
   (sdl2:renderer* enum -> void))
(define (render-draw-blend-mode-set! renderer blend-mode)
  (define (bad-mode-err x)
    (error 'render-draw-blend-mode-set!
           "Invalid blend mode" x))
  (let ((mode-int (if (integer? blend-mode)
                      blend-mode
                      (symbol->blend-mode
                       blend-mode bad-mode-err))))
    (try-call (SDL_SetRenderDrawBlendMode renderer mode-int))
    (void)))

(set! (setter render-draw-blend-mode) render-draw-blend-mode-set!)


(: render-draw-color
   (sdl2:renderer* -> fixnum fixnum fixnum fixnum))
(define (render-draw-color renderer)
  (with-temp-mem ((r-out (%allocate-Uint8))
                  (g-out (%allocate-Uint8))
                  (b-out (%allocate-Uint8))
                  (a-out (%allocate-Uint8)))
    (try-call (SDL_GetRenderDrawColor renderer
                                      r-out g-out
                                      b-out a-out)
              on-fail: (begin (free r-out)
                              (free g-out)
                              (free b-out)
                              (free a-out)))
    (values (pointer-u8-ref r-out)
            (pointer-u8-ref g-out)
            (pointer-u8-ref b-out)
            (pointer-u8-ref a-out))))


(: render-draw-color-set!
   (sdl2:renderer*
    (or sdl2:color*
        (list fixnum fixnum fixnum)
        (list fixnum fixnum fixnum fixnum))
    -> void))
(define (render-draw-color-set! renderer rgba-or-color)
  (receive (r g b a) (if (list? rgba-or-color)
                         (values (list-ref rgba-or-color 0)
                                 (list-ref rgba-or-color 1)
                                 (list-ref rgba-or-color 2)
                                 (if (< 3 (length rgba-or-color))
                                     (list-ref rgba-or-color 3)
                                     255))
                         (values (color-r rgba-or-color)
                                 (color-g rgba-or-color)
                                 (color-b rgba-or-color)
                                 (color-a rgba-or-color)))
    (try-call (SDL_SetRenderDrawColor renderer r g b a))
    (void)))

(set! (setter render-draw-color) render-draw-color-set!)


;;; "Colour" aliases
(define render-draw-colour      render-draw-color)
(define render-draw-colour-set! render-draw-color-set!)


(: render-clear!
   (sdl2:renderer* -> void))
(define (render-clear! renderer)
  (try-call (SDL_RenderClear renderer))
  (void))


(: render-draw-line!
   (sdl2:renderer* integer integer integer integer -> void))
(define (render-draw-line! renderer x1 y1 x2 y2)
  (try-call (SDL_RenderDrawLine renderer x1 y1 x2 y2))
  (void))


(: render-draw-lines!
   (sdl2:renderer*
    (or (list-of sdl2:point*) (vector-of sdl2:point*))
    -> void))
(define (render-draw-lines! renderer points)
  (receive (point-array len) (%points->array points)
    (try-call (SDL_RenderDrawLines renderer point-array len)
              on-fail: (free point-array))
    (free point-array)
    (void)))


(: render-draw-point!
   (sdl2:renderer* integer integer -> void))
(define (render-draw-point! renderer x y)
  (try-call (SDL_RenderDrawPoint renderer x y))
  (void))


(: render-draw-points!
   (sdl2:renderer*
    (or (list-of sdl2:point*) (vector-of sdl2:point*))
    -> void))
(define (render-draw-points! renderer points)
  (receive (point-array len) (%points->array points)
    (try-call (SDL_RenderDrawPoints renderer point-array len)
              on-fail: (free point-array))
    (free point-array)
    (void)))


(: render-draw-rect!
   (sdl2:renderer* (or sdl2:rect* false) -> void))
(define (render-draw-rect! renderer rect)
  (try-call (SDL_RenderDrawRect renderer rect))
  (void))


(: render-draw-rects!
   (sdl2:renderer*
    (or (list-of sdl2:rect*) (vector-of sdl2:rect*))
    -> void))
(define (render-draw-rects! renderer rects)
  (receive (rect-array len) (%rects->array rects)
    (try-call (SDL_RenderDrawRects renderer rect-array len)
              on-fail: (free rect-array))
    (free rect-array)
    (void)))


(: render-fill-rect!
   (sdl2:renderer* (or sdl2:rect* false) -> void))
(define (render-fill-rect! renderer rect)
  (try-call (SDL_RenderFillRect renderer rect))
  (void))


(: render-fill-rects!
   (sdl2:renderer*
    (or (list-of sdl2:rect*) (vector-of sdl2:rect*))
    -> void))
(define (render-fill-rects! renderer rects)
  (receive (rect-array len) (%rects->array rects)
    (try-call (SDL_RenderFillRects renderer rect-array len)
              on-fail: (free rect-array))
    (free rect-array)
    (void)))