;;;; geopolygon.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Aug '17
;;;; Kon Lovett, May '17

(module geopolygon

(;export
  make-geopolygon
  geopolygon? check-geopolygon error-geopolygon
  geopolygon list->geopolygon geopolygon->list
  geopolygon-closed? geopolygon-open?
  geopolygon-bounding-box
  geopolygon~=)

(import scheme
  (chicken base)
  (chicken type)
  (chicken flonum)
  srfi-1
  vector-lib
  (only type-checks-basic define-check+error-type)
  geopoint geobox)

(include-relative "geo-utils.types")

(: make-geopolygon ((or (list-of geopoint) (vector-of geopoint)) --> geopolygon))
(: geopolygon? (* -> boolean : geopolygon))

(: geopolygon (#!rest geopoint --> geopolygon))

(: list->geopolygon ((list-of geopoint) --> geopolygon))
(: geopolygon->list (geopolygon --> (list-of geopoint)))

(: geopolygon-closed? (geopolygon --> boolean))
(: geopolygon-open? (geopolygon --> boolean))
(: geopolygon-bounding-box (geopolygon --> geobox))

(: geopolygon~= (geopolygon geopolygon #!optional real --> boolean))

;;;

(include "geo-constants")

;;

;not strict
(define (make-geopolygon gps)
  (cond ((list? gps)
          (unless (every geopoint? gps)
            (error 'make-geopolygon "every element must be a geopoint" gps) )
          (list->vector gps) )
        ((vector? gps)
          (unless (vector-every geopoint? gps)
            (error 'make-geopolygon "every element must be a geopoint" gps) )
          gps )
        (else
          (error 'make-geopolygon "bad argument - not a list-of geopoint" gps) ) ) )

(define (geopolygon? obj) (and (vector? obj) (vector-every geopoint? obj)))

(define-check+error-type geopolygon)

(define (list->geopolygon gps) (make-geopolygon gps))

(define (geopolygon . gps) (make-geopolygon gps))

(define (geopolygon->list gpoly)
  (vector->list (check-geopolygon 'geopolygon-closed? gpoly)) )

; explicitly closed means [0] = [n-1]
;
(define (geopolygon-closed? gpoly)
  (let ((len (vector-length (check-geopolygon 'geopolygon-closed? gpoly))))
    (and (<= 2 len)
         (geopoint= (vector-ref gpoly 0) (vector-ref gpoly (- len 1)))) ) )

; explicitly open means [0] != [n-1]
;
(define (geopolygon-open? gpoly) (not (geopolygon-closed? gpoly)))

;;

(define (geopolygon-bounding-box gpoly)
  (let ((len (vector-length (check-geopolygon 'geopolygon-bounding-box gpoly))))
    (let loop ((i (the fixnum 0))
               (minLat (the real 90)) (maxLat (the real -90))
               (minLon (the real 180)) (maxLon (the real -180)))
      ;traced polygon?
      (if (= i len)
        ;then report
        (make-geobox minLat minLon maxLat maxLon)
        ;else next point in poly
        (let* ((pnt (vector-ref gpoly i))
               (lat (geopoint-latitude pnt))
               (lon (geopoint-longitude pnt)) )
          (loop (+ i 1)
                (min lat minLat) (max lat maxLat)
                (min lon minLon) (max lon maxLon)) ) ) ) ) )

;;

(define (geopolygon~= gpoly1 gpoly2 #!optional (eps flonum-epsilon))
  (and (= (vector-length (check-geopolygon 'geopolygon~= gpoly1))
          (vector-length (check-geopolygon 'geopolygon~= gpoly2)))
       (vector-every (cut geopoint~= <> <> eps) gpoly1 gpoly2)) )

) ;geopolygon