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

(import test)

(import (only (chicken format) format) (test-utils gloss))

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

;;;

(define-constant flLAT1 33.54187)
(define-constant flLON1 -117.78392)

(define-constant flLAT2 33.54444)
(define-constant flLON2 -117.78521)

(import geo-utils)

;33.54444 -117.78124 33.54692 -117.78438

(test-group "geo-utils"
  (let ((dis (great-circle-distance flLAT1 flLON1 flLAT2 flLON2))
        (azi (great-circle-azimuth flLAT1 flLON1 flLAT2 flLON2))
        (dea (approximate-ellipsoid-distance flLAT1 flLON1 flLAT2 flLON2))
        (sds (spherical-surface-distance flLAT1 flLON1 flLAT2 flLON2)) )
    ;
    (glossf "            GP1 - GP2: ~A, ~A : ~A, ~A" flLAT1 flLON1 flLAT2 flLON2)
    (glossf "great-circle-distance: ~A" dis)
    (glossf "   spherical-distance: ~A" sds)
    (glossf "   ellipsoid-distance: ~A" dea)
    (glossf "              azimuth: ~A" azi)
    (test 0.310118259985894 dis)
    (test 0.278350802526047 sds)
    (test 0.308717805933004 dea)
    (test 359.996476863012 azi)
    (receive (lat lon) (great-circle-position flLAT1 flLON1 dis azi)
      (glossf "        geopoint test: ~A, ~A" lat lon)
      (glossf "        geopoint base: ~A, ~A" flLAT2 flLON2)
      (test-assert (fp~= flLAT2 lat 0.009))
      (test-assert (fp~= flLON2 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 "W10° 20'30\"" #f))
  (test -10.3416666666667 (string-dms->degree "10° 20' 30\" W" #f))
  (test -10.3416666666667 (string-dms->degree "10° 20' 30\"W" #f))
  (test -10.3416666666667 (string-dms->degree "W10° 20'30\"" #t))

  (test "just degree" -10.0 (string-dms->degree "W 10° " #f))

  ;RI bounding-box
  (test "just degree+minute" -71.1166666666667 (string-dms->degree "71° 07′ W"))
  (test "just degree+minute" 41.15 (string-dms->degree "41° 09′ N" #t))
  (test "just degree+minute" -71.8833333333333 (string-dms->degree "71° 53′ W"))
  (test "just degree+minute" 42.0166666666667 (string-dms->degree "42° 01′ N" #t))

  (test 'N (degree->compass 10.3416666666667))
  (test 'E (degree->compass 100.3416666666667))

  (parameterize ((dms-glyphs '("°" "′" "”")))
    (test "override dms-glyphs" "41° 9′ 0” N" (dms->string 41 9 0 #t #f " ")) )
)

;;

(import geopoint)

(test-group "geopoint"
  (test-assert (geopoint? (make-geopoint flLAT1 flLON1)))
  (let ((gp1 (make-geopoint flLAT1 flLON1))
        (gp2 (make-geopoint flLAT2 flLON2)) )
    ;
    (test flLAT1 (geopoint-latitude gp1))
    (test flLON1 (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)))
    (test-assert (geopoint~= gp1 gp1)) )
)

;;

(import geobox)

(test-group "geobox"
  (let ((gp1 (make-geopoint flLAT1 flLON2))
        (gp2 (make-geopoint flLAT2 flLON1)) )
    ;
    (test-assert (geobox? (make-geobox gp1 gp2)))
    (let ((gb1 (make-geobox gp1 gp2)))
      ;
      (test gp1 (geobox-minimum gb1))
      (test gp2 (geobox-maximum gb1))
      (test-assert (geobox~= gb1 gb1)) ) )
)

;;

(import geopolygon)

(test-group "geopolygon"
  (let ((gpy1
          (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 (geopolygon~= gpy1 gpy1))
    (let ((gp1 (make-geopoint flLAT1 flLON2))
          (gp2 (make-geopoint flLAT2 flLON1)) )
      (test-assert
        (geobox~=
          (make-geobox (make-geopoint 37.835 -122.3201) (make-geopoint 37.8827 -122.2413))
          (geopolygon-bounding-box gpy1))) ) )
)

;;

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

(test-group "geo-globe"
  (let ((dis (great-circle-distance flLAT1 flLON1 flLAT2 flLON2))
        (azi (great-circle-azimuth flLAT1 flLON1 flLAT2 flLON2))
        ;
        (earth (make-earth))
        (gp1 (make-geopoint flLAT1 flLON1))
        (gp2 (make-geopoint flLAT2 flLON2)) )
    ;
    (test dis (globe:great-circle-distance earth gp1 gp2))
    (test azi (globe:great-circle-azimuth gp1 gp2))
    (test (approximate-ellipsoid-distance flLAT1 flLON1 flLAT2 flLON2)
          (globe:approximate-ellipsoid-distance earth gp1 gp2))
    (test (spherical-surface-distance flLAT1 flLON1 flLAT2 flLON2)
          (globe:spherical-surface-distance earth gp1 gp2))
    (let-values (((ulat ulon) (great-circle-position flLAT1 flLON1 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)