(module (s9fes char-canvas rect)

(;export
  ;
  rect
  rect?
  rect-x rect-y
  rect-wd rect-ht
  rect-spot rect-size
  ;
  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-inset rect-outset
  rect-reset
  ;
  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))

(: 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-spot (rect -> integer integer))
(: rect-size (rect -> integer 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-inset (rect integer integer -> rect))
(: rect-outset (rect integer integer -> rect))
(: rect-reset (rect #!optional integer integer -> rect))

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

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

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

;;

(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-spot rt) (%rect-spot rt))
(define (rect-size rt) (%rect-size 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) ) ) )

#| ;FIXME overlaps/area has false positives!
(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)
  (or (%rect-overlaps? rt1 rt2)
      (rect-overlaps/area? rt1 rt2) ) )
|#

(define (rect-overlaps? rt1 rt2) (%rect-overlaps? rt1 rt2))

(define (rect-bias rt dx dy)
  (%rect (+ (%rect-x rt) dx)  (+ (%rect-y rt) dy)
         (%rect-wd rt)        (%rect-ht rt)) )

(define (rect-scale rt sx sy)
  (%rect (%rect-x rt)           (%rect-y rt)
         (* (%rect-wd rt) sx)   (* (%rect-ht rt) sy)) )

(define (rect-inset rt dx dy)
  (%rect (+ (%rect-x rt) dx)          (+ (%rect-y rt) dy)
         (- (%rect-wd rt) (* dx 2))   (- (%rect-ht rt) (* dy 2))) )

(define (rect-outset rt dx dy)
  (%rect (- (%rect-x rt) dx)          (- (%rect-y rt) dy)
         (+ (%rect-wd rt) (* dx 2))   (+ (%rect-ht rt) (* dy 2))) )

(define (rect-reset rt #!optional (x0 0) (y0 0))
  (%rect x0 y0 (%rect-wd rt) (%rect-ht rt)) )

(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)