(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
  ;
  canvas->rect
  ;
  real-rect virtual-rect
  ;
  char-rect?
  char-canvas->rect)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken fixnum))
(import (s9fes char-canvas))

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

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

(: rect (integer integer integer integer -> rect))
;(: rect? (* -> boolean : vector))
(: 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))

(: canvas->rect (canvas -> rect))

(: real-rect (canvas rect -> rect))
(: virtual-rect (canvas rect -> rect))

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

(: char-canvas->rect (char-canvas -> 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-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 (canvas->rect cv) (*canvas->rect cv))

(define (char-rect? obj) (*char-rect? obj))
(define (char-canvas->rect cv) (*char-canvas->rect cv))

(define (real-rect cv rt)
  (let-values (((x y) (canvas-real cv (*rect-x rt) (*rect-y rt)))
               ((w h) (canvas-real cv (*rect-wd rt) (*rect-ht rt))) )
   (*rect x y w h) ) )

(define (virtual-rect cv rt)
  (let-values (((x y) (canvas-virtual cv (*rect-x rt) (*rect-y rt)))
               ((w h) (canvas-virtual cv (*rect-wd rt) (*rect-ht rt))) )
   (*rect x y w h) ) )

) ;module (s9fes char-canvas rect)