;;;; 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>=
  geopoint-within-box? )

(import scheme
  (chicken base)
  (chicken type)
  type-checks
  geopoint)

;;;

(define-type geopoint (struct geopoint))

(define-type geobox (struct geobox))

(: check-geopoint-above-left? (symbol * * --> boolean))
(: *make-geobox (geopoint geopoint --> geobox))
(: geobox? (* --> boolean))
(: *geobox-minimum (geobox --> geopoint))
(: *geobox-maximum (geobox --> geopoint))
;(: make-geobox (or (geopoint geopoint --> geobox) (number number number number --> geobox)))
(: geobox-minimum (geobox --> geopoint))
(: geobox-maximum (geobox --> geopoint))
(: geobox= (geobox geobox --> boolean))
(: geobox< (geobox geobox --> boolean))
(: geobox> (geobox geobox --> boolean))
(: geobox<= (geobox geobox --> boolean))
(: geobox>= (geobox geobox --> boolean))
(: geopoint-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 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)
  (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