(module (s9fes char-canvas rect)

(;export
  ;
  rect
  rect?
  rect-x rect-y
  rect-wd rect-ht
  ;
  rect-copy
  rect-null rect-null?
  ;
  rect-x-end rect-y-end
  rect-x-min rect-y-min
  rect-x-max rect-y-max
  ;
  rect-area
  rect-union rect-intersection
  rect-overlaps?
  rect-smaller? rect-larger?
  rect-relates
  ;
  rect-bias! rect-scale!
  rect-bias rect-scale
  ;
  rect->list list->rect
  rect->vector vector->rect
  ;
  char-rect?)

(import scheme)
(import (chicken base))
(import (chicken type))
(import record-variants)
(import (chicken fixnum))

(include-relative "s9fes.char-canvas.types")
(include-relative "s9fes.char-canvas.inlines")

;char-rect is-a rect but char-canvas isn't-a canvas!

(: rect (integer integer integer integer -> rect))
(: rect? (* -> boolean : rect-base))
;(: rect? (* --> boolean))

(: rect-null (-> rect))
(: rect-null? (* --> boolean))

(: rect-copy (rect -> rect))

(: rect-x (rect -> integer))
(: rect-y (rect -> integer))
(: rect-wd (rect -> integer))
(: rect-ht (rect -> integer))

(: rect-x-end (rect -> integer))
(: rect-y-end (rect -> integer))

(: rect-x-min (rect -> integer))
(: rect-y-min (rect -> integer))
(: rect-x-max (rect -> integer))
(: rect-y-max (rect -> integer))

(: rect-area (rect -> integer))

(: rect-smaller? (rect rect -> boolean))
(: rect-larger? (rect rect -> boolean))

(: rect-relates (rect rect -> (list-of symbol)))

(: rect-union (rect rect -> rect))
(: rect-intersection (rect rect -> rect))
(: rect-overlaps? (rect rect -> boolean))

(: rect-bias! (rect integer integer -> rect))
(: rect-scale! (rect real real -> rect))
(: rect-bias (rect integer integer -> rect))
(: rect-scale (rect real real -> rect))

(: rect->list (rect -> list))
(: list->rect (list -> rect))

(: rect->vector (rect -> vector))
(: vector->rect (vector -> rect))

(: char-rect? (* -> boolean : rect-base))
;(: char-rect? (* --> boolean))

;;

(define (rect x y w h) (%rect x y w h))
(define (rect? obj) (%rect? obj))

(define (rect-copy rt) (%rect (%rect-x rt) (%rect-y rt) (%rect-wd rt) (%rect-ht rt)))

(define (rect-x rt) (%rect-x rt))
(define (rect-y rt) (%rect-y rt))
(define (rect-wd rt) (%rect-wd rt))
(define (rect-ht rt) (%rect-ht rt))

(define (rect-null) (%rect-null))
(define (rect-null? rt) (%rect-null? rt))

(define (rect-x-end rt) (%rect-x-end rt))
(define (rect-y-end rt) (%rect-y-end rt))

(define (rect-x-min rt) (%rect-x-min rt))
(define (rect-y-min rt) (%rect-y-min rt))
(define (rect-x-max rt) (%rect-x-max rt))
(define (rect-y-max rt) (%rect-y-max rt))

(define (rect-area rt) (%rect-area rt))

(define (rect-smaller? rt1 rt2) (< (%rect-area rt1) (%rect-area rt2)))
(define (rect-larger? rt1 rt2)  (> (%rect-area rt1) (%rect-area rt2)))

(define (rect-relates rt1 rt2)
  `(,@(cond ((< (%rect-x rt1) (%rect-x rt2))    '(left))
            ((> (%rect-x rt1) (%rect-x rt2))    '(right))
            (else                               '()))
    ,@(cond ((< (%rect-y rt1) (%rect-y rt2))    '(below))
            ((> (%rect-y rt1) (%rect-y rt2))    '(above))
            (else                               '()))
    ,@(cond ((< (%rect-wd rt1) (%rect-wd rt2))  '(thinner))
            ((> (%rect-wd rt1) (%rect-wd rt2))  '(wider))
            (else                               '()))
    ,@(cond ((< (%rect-ht rt1) (%rect-ht rt2))  '(shorter))
            ((> (%rect-ht rt1) (%rect-ht rt2))  '(taller))
            (else                               '())) ) )

(define (rect-union rt1 rt2)
  (let ((x (min (%rect-x rt1) (%rect-x rt2)))
        (y (min (%rect-y rt1) (%rect-y rt2)))
        (x-end (max (%rect-x-end rt1) (%rect-x-end rt2)))
        (y-end (max (%rect-y-end rt1) (%rect-y-end rt2))) )
    (%rect x y (- x-end x) (- y-end y)) ) )

;https://stackoverflow.com/questions/2752349/fast-rectangle-to-rectangle-intersection
(define (rect-intersection rt1 rt2)
  (let ((x (max (%rect-x rt1) (%rect-x rt2)))
        (y (max (%rect-y rt1) (%rect-y rt2)))
        (x-end (min (%rect-x-end rt1) (%rect-x-end rt2)))
        (y-end (min (%rect-y-end rt1) (%rect-y-end rt2))) )
    (if (and (<= x x-end) (<= y y-end))
        (%rect x y (- x-end x) (- y-end y))
        (%rect-null) ) ) )

(define-inline (rect-overlaps/fast? rt1 rt2)
  (and (<= (%rect-x rt1) (%rect-x-end rt2))
       (<= (%rect-x rt2) (%rect-x-end rt1))
       (<= (%rect-y rt1) (%rect-y-end rt2))
       (<= (%rect-y rt2) (%rect-y-end rt1))) )

#; ;FIXME area is wonky
(define-inline (rect-overlaps/area? rt1 rt2)
  (let ((x_overlap (max 0
                        (- (min (%rect-x-end rt1) (%rect-x-end rt2))
                           (max (%rect-x rt1) (%rect-x rt2)))))
        (y_overlap (max 0
                        (- (min (%rect-y-end rt1) (%rect-y-end rt2))
                           (max (%rect-y rt1) (%rect-y rt2))))) )
    (zero? (* x_overlap y_overlap)) ) )

(define (rect-overlaps? rt1 rt2)
  (rect-overlaps/fast? rt1 rt2)
  #; ;FIXME area is wonky
  (or (rect-overlaps/fast? rt1 rt2)
      (rect-overlaps/area? rt1 rt2) ) )

(define (rect-bias! rt dx dy)
  (set! (vector-ref rt 0) (+ (vector-ref rt 0) dx))
  (set! (vector-ref rt 1) (+ (vector-ref rt 1) dy))
  rt )

(define (rect-scale! rt sx sy)
  (set! (vector-ref rt 2) (* (vector-ref rt 2) sx))
  (set! (vector-ref rt 3) (* (vector-ref rt 3) sy))
  rt )

(define (rect-bias rt dx dy) (rect-bias! (rect-copy rt) dx dy))
(define (rect-scale rt sx sy) (rect-scale! (rect-copy rt) sx sy))

(define (rect->list rt) (%rect->list rt))
(define (list->rect ls) (%list->rect ls))

(define (rect->vector rt) (%rect->vector rt))
(define (vector->rect ls) (%vector->rect ls))

(define (char-rect? obj) (%char-rect? obj))

) ;module (s9fes char-canvas rect)