;;;; geo-utils-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, May '17

(import test)

(test-begin "Geo Utils")

;;;

(import (chicken flonum))

;;; FP Utils

;;

(: fp~= (float float #!optional float --> boolean))
;
(define (fp~= x y #!optional (eps flonum-epsilon))
  (let (
    (diff (fp- x y)) )
    (or
      ;(fpzero? diff) ;really, how often is this true?
      (fp<= (fpabs diff) eps) ) ) )

;;;

(import geo-utils)

(define lat1 33.54187)
(define lon1 -117.78392)

(define lat2 33.54444)
(define lon2 -117.78521)

;33.54444 -117.78124 33.54692 -117.78438

(test-group "geo-utils"
  (let (
    (dis (great-circle-distance lat1 lon1 lat2 lon2) )
    (azi (great-circle-azimuth lat1 lon1 lat2 lon2) )
    (dea (approximate-ellipsoid-distance lat1 lon1 lat2 lon2) )
    (sds (spherical-surface-distance lat1 lon1 lat2 lon2) ) )
    ;
    (print "great-circle-distance: " dis)
    (print "   spherical-distance: " sds)
    (print "   ellipsoid-distance: " dea)
    (print "              azimuth: " azi)
    (receive (lat lon) (great-circle-position lat1 lon1 dis azi)
      (print "        geopoint test: " lat ", " lon)
      (print "        geopoint base: " lat2 ", " lon2)
      (test-assert (fp~= lat2 lat 0.009))
      (test-assert (fp~= lon2 lon 0.009)) ) )
)

;;

(import geo-dms)

(test-group "geo-dms"
  (test "W 10° 20' 30\"" (dms->string -10 20 30 #f #t " "))
  (test "E 10° 20' 30\"" (dms->string 10 20 30 #f #t " "))
  (test "S 10° 20' 30\"" (dms->string -10 20 30 #t #t " "))
  (test "N 10° 20' 30\"" (dms->string 10 20 30 #t #t " "))

  (test -10.3416666666667 (string-dms->degree "W 10° 20' 30\"" #f))
  (test -10.3416666666667 (string-dms->degree "10° 20' 30\" W" #f))
  (test -10.3416666666667 (string-dms->degree "W10° 20'30\"" #t))
)

;;

(import geopoint)

(test-group "geopoint"
  (test-assert (geopoint? (make-geopoint lat1 lon1)))
  (let (
    (gp1 (make-geopoint lat1 lon1) )
    (gp2 (make-geopoint lat2 lon2) ) )
    ;
    (test lat1 (geopoint-latitude gp1))
    (test lon1 (geopoint-longitude gp1))
    ;
    (test-assert (not (geopoint-left? gp1 gp2)))
    (test-assert (geopoint-right? gp1 gp2))
    (test-assert (geopoint-above? gp1 gp2))
    (test-assert (not (geopoint-below? gp1 gp2))) )
)

;;

(import geopolygon)
(import geopoint-utils)

(test-group "geopolygon"
  (let (
    (gpy1
      (make-geopolygon
        (make-geopoint 37.8731 -122.3201)
        (make-geopoint 37.8827 -122.2705)
        (make-geopoint 37.8817 -122.2535)
        (make-geopoint 37.8617 -122.2413)
        (make-geopoint 37.8429 -122.2431)
        (make-geopoint 37.8350 -122.3175)) ) )
    ;
    (test-assert (geopolygon? gpy1))
    (test-assert (geopoint-in-closed-polygon? (make-geopoint 37.8429 -122.2431) gpy1))
    (test-assert (not (geopoint-in-closed-polygon? (make-geopoint -37.8429 122.2431) gpy1))) )
)

;;

(import geobox)

(test-group "geobox"
  (let (
    (gp1 (make-geopoint lat1 lon2) )
    (gp2 (make-geopoint lat2 lon1) ) )
    ;
    (test-assert (geobox? (make-geobox gp1 gp2)))
    (let (
      (gb1 (make-geobox gp1 gp2) ) )
      ;
      (test gp1 (geobox-minimum gb1))
      (test gp2 (geobox-maximum gb1))
      ;
      (let ((gpy1 (geopolygon gp2 gp1)))
        (test-assert (geopolygon? gpy1))
        (test-assert (geobox= gb1 (geopolygon-bounding-box gpy1))) ) ) )
)

;;

(import (prefix geo-globe globe:) geo-earth)

(test-group "geo-globe"
  (let (
    (dis (great-circle-distance lat1 lon1 lat2 lon2) )
    (azi (great-circle-azimuth lat1 lon1 lat2 lon2) )
    ;
    (earth (make-earth) )
    (gp1 (make-geopoint lat1 lon1) )
    (gp2 (make-geopoint lat2 lon2) ) )
    ;
    (test dis (globe:great-circle-distance earth gp1 gp2))
    (test azi (globe:great-circle-azimuth gp1 gp2))
    (test
      (approximate-ellipsoid-distance lat1 lon1 lat2 lon2)
      (globe:approximate-ellipsoid-distance earth gp1 gp2))
    (test
      (spherical-surface-distance lat1 lon1 lat2 lon2)
      (globe:spherical-surface-distance earth gp1 gp2))
    (let-values (((ulat ulon) (great-circle-position lat1 lon1 dis azi)))
      (let ((pos (globe:great-circle-position earth gp1 dis azi)))
        (test "great-circle-position latitude" ulat (geopoint-latitude pos))
        (test "great-circle-position longitude" ulon (geopoint-longitude pos)) ) ) )
)

;;;

(test-end "Geo Utils")

(test-exit)