;;;; 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-type geopoint (struct geopoint))

(define-type geobox (struct geobox))

;;

(: *make-geobox (geopoint geopoint --> geobox))
(: geobox? (* --> boolean))
(: *geobox-minimum (geobox --> geopoint))
(: *geobox-maximum (geobox --> geopoint))
(define-record-type geobox
  (*make-geobox min max)
  geobox?
  (min *geobox-minimum)
  (max *geobox-maximum) )

;(: make-geobox (or (geopoint geopoint --> geobox) (number number number number --> geobox)))
(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)) ) ) )

(: make-geobox* (symbol geopoint geopoint --> geobox))
(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-check+error-type geobox)

(: geobox-minimum (geobox --> geopoint))
(define (geobox-minimum gb)
  (*geobox-minimum (check-geobox 'geobox-minimum gb)) )

(: geobox-maximum (geobox --> geopoint))
(define (geobox-maximum gb)
  (*geobox-maximum (check-geobox 'geobox-maximum gb)) )

;;

(: geobox= (geobox geobox --> boolean))
(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)) ) )

(: geobox< (geobox geobox --> boolean))
(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)) ) )

(: geobox> (geobox geobox --> boolean))
(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)) ) )

(: geobox<= (geobox geobox --> boolean))
(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)) ) )

(: geobox>= (geobox geobox --> boolean))
(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)) ) )

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

) ;geobox