;;;; 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)

;;;

;;

(define *make-geopoint cons)
(define *geopoint-latitude car)
(define *geopoint-longitude cdr)

;;;

(define (make-geopoint lat lon)
  (*make-geopoint
    (check-real 'make-geopoint lat "lat")
    (check-real 'make-geopoint lon "lon")) )

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

(define-check+error-type geopoint)

(define (geopoint-latitude gp)
  (*geopoint-latitude (check-geopoint 'geopoint-latitude gp)) )

(define (geopoint-longitude gp)
  (*geopoint-longitude (check-geopoint 'geopoint-longitude gp)) )

;;

(define (geopoint-strictly-above gp1 gp2)
  (check-geopoint 'geopoint-strictly-above gp1)
  (check-geopoint 'geopoint-strictly-above gp2)
  (< (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(define (geopoint-above gp1 gp2)
  (check-geopoint 'geopoint-above gp1)
  (check-geopoint 'geopoint-above gp2)
  (<= (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(define (geopoint-strictly-below gp1 gp2)
  (check-geopoint 'geopoint-strictly-below gp1)
  (check-geopoint 'geopoint-strictly-below gp2)
  (> (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(define (geopoint-below gp1 gp2)
  (check-geopoint 'geopoint-below gp1)
  (check-geopoint 'geopoint-below gp2)
  (>= (*geopoint-latitude gp1) (*geopoint-latitude gp2)) )

(define (geopoint-strictly-left gp1 gp2)
  (check-geopoint 'geopoint-strictly-left gp1)
  (check-geopoint 'geopoint-strictly-left gp2)
  (< (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(define (geopoint-left gp1 gp2)
  (check-geopoint 'geopoint-left gp1)
  (check-geopoint 'geopoint-left gp2)
  (<= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(define (geopoint-strictly-right gp1 gp2)
  (check-geopoint 'geopoint-strictly-right gp1)
  (check-geopoint 'geopoint-strictly-right gp2)
  (> (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(define (geopoint-right gp1 gp2)
  (check-geopoint 'geopoint-right gp1)
  (check-geopoint 'geopoint-right gp2)
  (>= (*geopoint-longitude gp1) (*geopoint-longitude gp2)) )

(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)) ) )

(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)) ) )

(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)) ) )

(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)) ) )

(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