;;;; geobox.scm
;;;; Kon Lovett, May '17

(module geobox

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

(import scheme chicken)

(use type-checks)

(use geopoint)

;;;

;;

(define *make-geobox cons)
(define *geobox-minimum car)
(define *geobox-maximum cdr)

;;;

(define make-geobox
  (case-lambda
    ((min-pnt max-pnt)
      (make-geobox* 'make-geobox min-pnt max-pnt) )
    ((minLat minLon maxLat maxLon)
      (make-geobox* 'make-geobox
        (make-geopoint minLat minLon) (make-geopoint maxLat maxLon)) ) ) )

(define (make-geobox* loc min-pnt max-pnt)
  (check-geopoint loc min-pnt)
  (check-geopoint loc max-pnt)
  (unless
    (and
      (geopoint-above min-pnt max-pnt)
      (geopoint-left min-pnt max-pnt) )
    (error loc "minimum-geopoint > maximum-geopoint" min-pnt max-pnt) )
  (*make-geobox min-pnt max-pnt) )

(define (geobox? obj)
  (and
    (pair? obj)
    (geopoint? (car obj))
    (geopoint? (cdr obj))) )

(define-check+error-type geobox)

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

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

(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 (geopoint-within-box gp gb)
  (and
    (geopoint<= (*geobox-minimum gb) gp)
    (geopoint>= (*geobox-maximum gb) gp) ) )

) ;geobox