(module (s9fes char-canvas rect)

(;export
  ;
  rect
  rect?
  rect-copy
  rect-x rect-y
  rect-wd rect-ht
  ;
  rect-x-end rect-y-end
  rect-x-min rect-y-min
  rect-x-max rect-y-max
  ;
  rect-area
  ;
  rect-bias! rect-scale!
  rect-bias rect-scale
  ;
  rect->list list->rect
  ;
  canvas->rect
  ;
  char-rect?
  char-canvas->rect
  ;
  physical-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-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-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))

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

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

(: physical-rect (canvas rect -> 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-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)
  (*rect (min (*rect-x rt1) (*rect-x rt2)) (min (*rect-y rt1) (*rect-y rt2))
         (max (*rect-wd rt1) (*rect-wd rt2)) (max (*rect-ht rt1) (*rect-ht rt2))) )

(define (rect-intersection rt1 rt2)
 (*rect 0 0 0 0) )

(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 (physical-rect cv rt)
  (let-values (((x y) (canvas-physical cv (*rect-x rt) (*rect-y rt)))
               ((w h) (canvas-physical cv (*rect-wd rt) (*rect-ht rt))) )
   (*rect x y w h) ) )

) ;module (s9fes char-canvas rect)