source: project/release/4/geo-utils/tags/0.3.0/geopolygon.scm @ 34507

Last change on this file since 34507 was 34507, checked in by kon, 9 months ago

rel 0.3.0

File size: 2.1 KB
Line 
1;;;; geopolygon.scm
2;;;; Kon Lovett, May '17
3;;;; Kon Lovett, Aug '17
4
5(module geopolygon
6
7(;export
8  make-geopolygon
9  geopolygon? check-geopolygon error-geopolygon
10  geopolygon
11  geopolygon-closed? geopolygon-open?
12  geopolygon-bounding-box )
13
14(import scheme)
15
16(import chicken)
17
18(use vector-lib)
19
20(use type-checks)
21
22(use geopoint geobox)
23
24;;;
25
26(define-type geopolygon (or (list-of (struct geopoint)) (vector-of (struct geopoint))))
27
28;not strict
29(define make-geopolygon
30  (case-lambda
31    ((gps)
32      (cond
33        ((vector? gps)  gps )
34        ((list? gps)    (list->vector gps) )
35        (else
36          (warning 'make-geopolygon "unrecognized as geopolygon" gps)
37          gps ) ) )
38    (rest
39      (make-geopolygon rest) ) ) )
40
41(: geopolygon? (* --> boolean))
42(define (geopolygon? obj)
43  (and
44    (vector? obj)
45    (vector-every geopoint? obj)) )
46
47(define-check+error-type geopolygon)
48
49(define (geopolygon . gps)
50  (make-geopolygon gps) )
51
52; explicitly closed means [0] = [n-1]
53(: geopolygon-closed? (geopolygon --> boolean))
54(define (geopolygon-closed? gpoly)
55        (let* ((gpoly (if (list? gpoly) (list->vector gpoly) gpoly))
56               (len (vector-length gpoly)) )
57          (and
58            (fx<= 2 len)
59            (geopoint= (vector-ref gpoly 0) (vector-ref gpoly (fx- len 1))) ) ) )
60
61; explicitly open means [0] != [n-1]
62(: geopolygon-open? (geopolygon --> boolean))
63(define (geopolygon-open? gpoly)
64        (not (geopolygon-closed? gpoly)) )
65
66;;
67
68(: geopolygon-bounding-box (geopolygon --> (struct geobox)))
69(define (geopolygon-bounding-box gpoly)
70        (let ((gpoly (if (list? gpoly) (list->vector gpoly) gpoly)))
71          (check-geopolygon 'geopolygon-bounding-box gpoly)
72          (let ((len (vector-length gpoly)))
73      (let loop ((i 0) (minLat 90.0) (minLon 180.0) (maxLat -90.0) (maxLon -180.0))
74        (if (fx= i len)
75          (make-geobox minLat minLon maxLat maxLon)
76          (let* ((pnt (vector-ref gpoly i))
77                 (lat (geopoint-latitude pnt) )
78                 (lon (geopoint-longitude pnt) ) )
79            (loop (fx+ i 1) (min lat minLat) (min lon minLon) (max lat maxLat) (max lon maxLon)) ) ) ) ) ) )
80
81) ;geopolygon
Note: See TracBrowser for help on using the repository browser.