;;;; geobox.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, May '17

(module geobox

(;export
  make-geobox
  geobox? check-geobox error-geobox
  geobox-minimum geobox-maximum
  geobox~=
  geobox= geobox< geobox> geobox<= geobox>=
  within-box?
  ;DEPRECATED
  geopoint-within-box?)

(import scheme
  (chicken base)
  (chicken type)
  (chicken flonum)
  (chicken format)
  (only type-checks-basic define-check+error-type)
  (only (check-errors sys) check-real)
  geopoint)

(include-relative "geo-utils.types")

(: check-geopoint-above-left? (symbol * * -> boolean))

(: *make-geobox (geopoint geopoint --> geobox))
(: geobox? (* -> boolean : geobox))
(: *geobox-minimum (geobox --> geopoint))
(: *geobox-maximum (geobox --> geopoint))

#; ;FIXME handle case-lambda better
(: make-geobox (or (geopoint geopoint -> geobox) (real real real real -> geobox)))
(: make-geobox ((or geopoint real) (or geopoint real) #!optional real real -> geobox))

(: geobox-minimum (geobox --> geopoint))
(: geobox-maximum (geobox --> geopoint))

(: geobox~= (geobox geobox #!optional real --> boolean))

(: geobox= (geobox geobox --> boolean))
(: geobox< (geobox geobox --> boolean))
(: geobox> (geobox geobox --> boolean))
(: geobox<= (geobox geobox --> boolean))
(: geobox>= (geobox geobox --> boolean))

(: within-box? (geopoint geobox --> boolean))

;;

(define (check-geopoint-above-left? loc a b)
  (check-geopoint loc a 'min)
  (check-geopoint loc b 'max)
  (and (geopoint-above? a b) (geopoint-left? a b)) )

;;

(define-record-type geobox
  (*make-geobox min max)
  geobox?
  (min *geobox-minimum)
  (max *geobox-maximum) )

(define (print-geobox/unrec gb out)
  (format out "#<geobox ~A ~A>"
              (*geobox-minimum gb) (*geobox-maximum gb)) )

(define-record-printer (geobox gb out) (print-geobox/unrec gb out))

(define make-geobox
  (case-lambda
    ;
    ((min-pnt max-pnt)
      (unless (check-geopoint-above-left? 'make-geobox min-pnt max-pnt)
        (error 'make-geobox "min geopoint > max geopoint" min-pnt max-pnt) )
      (*make-geobox min-pnt max-pnt) )
    ;
    ((min-lat min-lon max-lat max-lon)
      (make-geobox
        (make-geopoint
          (check-real 'make-geobox min-lat)
          (check-real 'make-geobox min-lon))
        (make-geopoint
          (check-real 'make-geobox max-lat)
          (check-real 'make-geobox max-lon))) ) ) )

(define-check+error-type geobox)

(define (geobox-minimum gb)
  (*geobox-minimum (check-geobox 'geobox-minimum gb)) )

(define (geobox-maximum gb)
  (*geobox-maximum (check-geobox 'geobox-maximum gb)) )

;;

(define (geobox~= gb1 gb2 #!optional (eps flonum-epsilon))
  (check-geobox 'geobox~= gb1)
  (check-geobox 'geobox~= gb2)
  (and (geopoint~= (*geobox-minimum gb1) (*geobox-minimum gb2) eps)
       (geopoint~= (*geobox-maximum gb1) (*geobox-maximum gb2) eps)) )

(define (geobox= gb1 gb2)
  (check-geobox 'geobox= gb1)
  (check-geobox 'geobox= gb2)
  (and (geopoint= (*geobox-minimum gb1) (*geobox-minimum gb2))
       (geopoint= (*geobox-maximum gb1) (*geobox-maximum gb2))) )

(define (geobox< gb1 gb2)
  (check-geobox 'geobox< gb1)
  (check-geobox 'geobox< gb2)
  (and (geopoint< (*geobox-minimum gb1) (*geobox-minimum gb2))
       (geopoint< (*geobox-maximum gb1) (*geobox-maximum gb2))) )

(define (geobox> gb1 gb2)
  (check-geobox 'geobox> gb1)
  (check-geobox 'geobox> gb2)
  (and (geopoint> (*geobox-minimum gb1) (*geobox-minimum gb2))
       (geopoint> (*geobox-maximum gb1) (*geobox-maximum gb2))) )

(define (geobox<= gb1 gb2)
  (check-geobox 'geobox<= gb1)
  (check-geobox 'geobox<= gb2)
  (and (geopoint<= (*geobox-minimum gb1) (*geobox-minimum gb2))
       (geopoint<= (*geobox-maximum gb1) (*geobox-maximum gb2))) )

(define (geobox>= gb1 gb2)
  (check-geobox 'geobox>= gb1)
  (check-geobox 'geobox>= gb2)
  (and (geopoint>= (*geobox-minimum gb1) (*geobox-minimum gb2))
       (geopoint>= (*geobox-maximum gb1) (*geobox-maximum gb2))) )

(define (within-box? gp gb)
  (check-geopoint 'within-box? gp)
  (check-geobox 'within-box? gb)
  (and (geopoint<= (*geobox-minimum gb) gp)
       (geopoint>= (*geobox-maximum gb) gp)) )

;;

(: geopoint-within-box? (deprecated within-box?))
(define geopoint-within-box? within-box?)

) ;geobox