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

(import test)

(import (only (chicken format) format))
(include-relative "test-gloss.incl")

(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-constant flLAT1 33.54187)
(define-constant flLON1 -117.78392)

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

;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 (* 1.0 (string-dms->degree "W 10° 20' 30\"" #f)))
  (test -10.3416666666667 (* 1.0 (string-dms->degree "10° 20' 30\" W" #f)))
  (test -10.3416666666667 (* 1.0 (string-dms->degree "W10° 20'30\"" #t)))

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

;;

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

;;

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