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

(module geopoint

(;export
  make-geopoint
  geopoint? check-geopoint error-geopoint
  geopoint-latitude geopoint-longitude
  ;
  geopoint-strictly-above? geopoint-above? geopoint-strictly-below? geopoint-below?
  geopoint-strictly-left? geopoint-left? geopoint-strictly-right? geopoint-right?
  ;
  geopoint= geopoint< geopoint> geopoint<= geopoint>=
  ;
  )

(import scheme)

(import chicken)

(use type-checks)

;;;

;;

(: *make-geopoint (number number --> (struct geopoint)))
(: geopoint? (* --> boolean))
(: *geopoint-latitude ((struct geopoint) --> number))
(: *geopoint-longitude ((struct geopoint) --> number))
(define-record-type geopoint
  (*make-geopoint lat lon)
  geopoint?
  (lat *geopoint-latitude)
  (lon *geopoint-longitude) )

(: make-geopoint (number number --> (struct geopoint)))
(define (make-geopoint lat lon)
  (*make-geopoint
    (check-real 'make-geopoint lat 'lat)
    (check-real 'make-geopoint lon 'lon)) )

(define-check+error-type geopoint)

(: geopoint-latitude ((struct geopoint) --> number))
(define (geopoint-latitude gp)
  (*geopoint-latitude (check-geopoint 'geopoint-latitude gp)) )

(: geopoint-longitude ((struct geopoint) --> number))
(define (geopoint-longitude gp)
  (*geopoint-longitude (check-geopoint 'geopoint-longitude gp)) )

;;

(: geopoint-strictly-above? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-strictly-above? gp1 gp2)
  (check-geopoint 'geopoint-strictly-above gp1)
  (check-geopoint 'geopoint-strictly-above gp2)
  (< (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(: geopoint-above? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-above? gp1 gp2)
  (check-geopoint 'geopoint-above gp1)
  (check-geopoint 'geopoint-above gp2)
  (<= (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(: geopoint-strictly-below? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-strictly-below? gp1 gp2)
  (check-geopoint 'geopoint-strictly-below gp1)
  (check-geopoint 'geopoint-strictly-below gp2)
  (> (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(: geopoint-below? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-below? gp1 gp2)
  (check-geopoint 'geopoint-below gp1)
  (check-geopoint 'geopoint-below gp2)
  (>= (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(: geopoint-strictly-left? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-strictly-left? gp1 gp2)
  (check-geopoint 'geopoint-strictly-left gp1)
  (check-geopoint 'geopoint-strictly-left gp2)
  (< (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(: geopoint-left? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-left? gp1 gp2)
  (check-geopoint 'geopoint-left gp1)
  (check-geopoint 'geopoint-left gp2)
  (<= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(: geopoint-strictly-right? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-strictly-right? gp1 gp2)
  (check-geopoint 'geopoint-strictly-right gp1)
  (check-geopoint 'geopoint-strictly-right gp2)
  (> (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(: geopoint-right? ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint-right? gp1 gp2)
  (check-geopoint 'geopoint-right gp1)
  (check-geopoint 'geopoint-right gp2)
  (>= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

;;

(: geopoint= ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint= gp1 gp2)
  (check-geopoint 'geopoint= gp1)
  (check-geopoint 'geopoint= gp2)
  (and
    (= (*geopoint-latitude gp1) (*geopoint-latitude gp2))
    (= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) ) )

(: geopoint< ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint< gp1 gp2)
  (check-geopoint 'geopoint< gp1)
  (check-geopoint 'geopoint< gp2)
  (and
    (< (*geopoint-latitude gp1) (*geopoint-latitude gp2))
    (< (*geopoint-longitude gp1) (*geopoint-longitude gp2)) ) )

(: geopoint> ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint> gp1 gp2)
  (check-geopoint 'geopoint> gp1)
  (check-geopoint 'geopoint> gp2)
  (and
    (> (*geopoint-latitude gp1) (*geopoint-latitude gp2))
    (> (*geopoint-longitude gp1) (*geopoint-longitude gp2)) ) )

(: geopoint<= ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint<= gp1 gp2)
  (check-geopoint 'geopoint<= gp1)
  (check-geopoint 'geopoint<= gp2)
  (and
    (<= (*geopoint-latitude gp1) (*geopoint-latitude gp2))
    (<= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) ) )

(: geopoint>= ((struct geopoint) (struct geopoint) --> boolean))
(define (geopoint>= gp1 gp2)
  (check-geopoint 'geopoint>= gp1)
  (check-geopoint 'geopoint>= gp2)
  (and
    (>= (*geopoint-latitude gp1) (*geopoint-latitude gp2))
    (>= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) ) )

) ;geopoint