;;;; 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) (import scheme (chicken base) (chicken type) 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)) ;;; (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 90) (maxLat -90) (minLon 180) (maxLon -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)) ) ) ) ) ) ) ;geopolygon