Changeset 34129 in project


Ignore:
Timestamp:
05/30/17 16:34:08 (3 months ago)
Author:
kon
Message:

hello

Location:
release/4/geo-utils
Files:
18 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/geo-utils/tags/0.1.0/geo-dms.scm

    r34104 r34129  
    1010  string-dms->degree )
    1111
    12 (import scheme chicken)
     12(import scheme)
     13
     14(import chicken)
    1315
    1416(use irregex)
     17
    1518(use fp-utils)
     19
    1620(use mathh)
    1721
    1822;;;
    1923
    20 (define-constant +dms-degree-char+ "°")
    21 (define-constant +dms-minute-char+ "'")
    22 (define-constant +dms-second-char+ "\"")
     24(define-constant DEGREE-TEXT "°")
     25(define-constant MINUTE-TEXT "'")
     26(define-constant SECOND-TEXT "\"")
    2327
    2428(define +dms-regex+
     
    4246(define degree-minute-second-text
    4347  (make-parameter
    44     `(,+dms-degree-char+ ,+dms-minute-char+ ,+dms-second-char+)
     48    `(,DEGREE-TEXT ,MINUTE-TEXT ,SECOND-TEXT)
    4549    (lambda (x)
    4650      (if (and (list? x) (= 3 (length x)))
     
    5660(define (dms->string d m s #!optional lat? leading-dir? (pad ""))
    5761  (if (and (fx= d 0) (fx= m 0) (fx= s 0))
    58     ; return 0,0
     62    ;so 0
    5963    (dms0)
    60     ; construct DMS N/S/E/W
     64    ;construct DMS N/S/E/W
    6165    (let* ((neg? (fx< d 0))
    6266           (d (if neg? (fxneg d) d))
     
    7074; -122°45'10"E => -122.752777777778 even though E
    7175; -122°45'10"W => 122.752777777778 even though W
     76;
    7277(define (string-dms->degree str #!optional lat?)
    7378  (let ((match (irregex-match +dms-regex+ str)))
    74     (if (not match)
    75       (error 'string-dms->degree "improper DMS form" str)
    76       (let* (
    77           (leading-dir (irregex-match-substring match 1) )
    78           (leading-dir (and leading-dir (string-ref leading-dir 0)) )
    79           (d (string->number (irregex-match-substring match 2)) )
    80           (m (string->number (irregex-match-substring match 3)) )
    81           (s (string->number (irregex-match-substring match 4)) )
    82           (trailing-dir (irregex-match-substring match 5) )
    83           (trailing-dir (and trailing-dir (string-ref trailing-dir 0)) )
    84           (dir (or leading-dir trailing-dir) )
    85           ; input string overrides parameters
    86           (lat? (or (ns-dir? dir) lat?) )
    87           (neg? (sw-dir? dir) ) )
    88         (if (and dir (negative? d))
    89           (error 'string-dms->degree "improper DMS sign with direction" str)
    90           (let ((d (if neg? (- d) d)))
    91             (if (and
     79    (unless match
     80      (error 'string-dms->degree "improper DMS form" str) )
     81    (let* (
     82        (leading-dir (irregex-match-substring match 1) )
     83        (leading-dir (and leading-dir (string-ref leading-dir 0)) )
     84        (d (string->number (irregex-match-substring match 2)) )
     85        (m (string->number (irregex-match-substring match 3)) )
     86        (s (string->number (irregex-match-substring match 4)) )
     87        (trailing-dir (irregex-match-substring match 5) )
     88        (trailing-dir (and trailing-dir (string-ref trailing-dir 0)) )
     89        (dir (or leading-dir trailing-dir) )
     90        ; input string overrides parameters
     91        (lat? (or (ns-dir? dir) lat?) )
     92        (neg? (sw-dir? dir) ) )
     93      (when (and dir (negative? d))
     94        (error 'string-dms->degree "improper DMS sign with direction" str) )
     95      (let ((d (if neg? (- d) d)))
     96        (unless (and
    9297                  (if lat?
    9398                    (and (<= -90 d) (<= d 90))
     
    95100                  (and (<= 0 m) (<= m 59))
    96101                  (and (<= 0 s) (<= s 59)) )
    97               (dms->degree d m s)
    98               (error 'string-dms->degree "improper DMS value" str) ) ) ) ) ) ) )
     102          (error 'string-dms->degree "improper DMS value" str) )
     103        (dms->degree d m s) ) ) ) )
    99104
    100105;;
  • release/4/geo-utils/tags/0.1.0/geo-utils.meta

    r34104 r34129  
    44 (category math)
    55 (author "[[kon lovett]]")
    6  (license "Public Domain")
     6 (license "BSD")
    77 (doc-from-wiki)
    88 (synopsis "Geographic Utilities")
  • release/4/geo-utils/tags/0.1.0/geo-utils.scm

    r34104 r34129  
    1313  spherical-surface-distance
    1414  great-circle-distance great-circle-distance-radians
    15   #;straight-line-distance
     15  straight-line-distance
    1616  approximate-ellipsoid-distance
     17  ;
    1718  great-circle-azimuth
     19  ;
    1820  great-circle-position )
    1921
    20 (import scheme chicken)
     22(import scheme)
     23
     24(import chicken)
    2125
    2226(use numbers)
     27
    2328(use fp-utils)
    2429
     
    7479;;
    7580
    76 #;
    7781(define (straight-line-distance lat1 lon1 h1 lat2 lon2 h2 #!optional (R EARTH-RADIUS-MILES))
    78 )
     82  ;filler
     83  (pythagorean-distance lat1 lon1 lat2 lon2) )
    7984
    8085;;
     
    117122
    118123(define (great-circle-azimuth lat1 lon1 lat2 lon2 #!optional (prec 5))
    119 
     124  ;
    120125  (define precfact
    121     (fp* 360.0 (fpexpt 10.0 (exact->inexact prec))))
    122 
     126    (fp* 360.0 (fpprecision-factor prec)) )
     127  ;
    123128  (define (clamp n)
    124129    (inexact->exact (fpround (fp* n precfact))) )
    125 
     130  ;
    126131  (let ((ilat1 (clamp lat1))
    127132        (ilon1 (clamp lon1))
     
    134139          180.0
    135140          ; going down or nowhere
    136           0.0) )
     141          0.0 ) )
    137142      (else
    138143        (let ((lat1 (fpdegree->radian lat1))
  • release/4/geo-utils/tags/0.1.0/geo-utils.setup

    r34104 r34129  
    3737
    3838#|
    39 geo-dms.c:1132:38: error: use of undeclared identifier 'stub253'
     39geo-dms.c:404:38: error: use of undeclared identifier 'stub253'
    4040t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li5),tmp=(C_word)a,a+=3,tmp);
     41                                     ^
     42geo-dms.c:1372:38: error: use of undeclared identifier 'stub253'
     43t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li7),tmp=(C_word)a,a+=3,tmp);
     44                                     ^
     45geo-dms.c:1846:38: error: use of undeclared identifier 'stub253'
     46t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li3),tmp=(C_word)a,a+=3,tmp);
     47                                     ^
     483 errors generated.
    4149|#
  • release/4/geo-utils/tags/0.1.0/geobox.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  make-geobox
    98  geobox? check-geobox error-geobox
  • release/4/geo-utils/tags/0.1.0/geopoint-utils.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  geopoint-in-closed-polygon? )
    98
    10 (import scheme chicken)
     9(import scheme)
     10
     11(import chicken)
    1112
    1213(use numbers)
  • release/4/geo-utils/tags/0.1.0/geopoint.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  make-geopoint
    98  geopoint? check-geopoint error-geopoint
     
    1312  geopoint= geopoint< geopoint> geopoint<= geopoint>= )
    1413
    15 (import scheme chicken)
     14(import scheme)
     15
     16(import chicken)
    1617
    1718(use type-checks)
  • release/4/geo-utils/tags/0.1.0/geopolygon.scm

    r34104 r34129  
    1111  geopolygon-bounding-box )
    1212
    13 (import scheme chicken)
     13(import scheme)
     14
     15(import chicken)
    1416
    1517(use vector-lib)
  • release/4/geo-utils/tags/0.1.0/tests/run.scm

    r34104 r34129  
    1010(define lat1 33.54187)
    1111(define lon1 -117.78392)
     12
    1213(define lat2 33.54444)
    1314(define lon2 -117.78521)
     
    2324  (print "   ellipsoid-distance: " dea)
    2425  (print "              azimuth: "  a)
    25   (let-values (((lat lon) (great-circle-position lat1 lon1 d a)))
    26     (print "             geopoint test: " lat ", " lon)
    27     (print "             geopoint base: " lat2 ", " lon2)
     26  (receive (lat lon) (great-circle-position lat1 lon1 d a)
     27    (print "        geopoint test: " lat ", " lon)
     28    (print "        geopoint base: " lat2 ", " lon2)
    2829    (test-assert (fp~= lat2 lat 0.009))
    2930    (test-assert (fp~= lon2 lon 0.009)) ) )
  • release/4/geo-utils/trunk/geo-dms.scm

    r34104 r34129  
    1010  string-dms->degree )
    1111
    12 (import scheme chicken)
     12(import scheme)
     13
     14(import chicken)
    1315
    1416(use irregex)
     17
    1518(use fp-utils)
     19
    1620(use mathh)
    1721
    1822;;;
    1923
    20 (define-constant +dms-degree-char+ "°")
    21 (define-constant +dms-minute-char+ "'")
    22 (define-constant +dms-second-char+ "\"")
     24(define-constant DEGREE-TEXT "°")
     25(define-constant MINUTE-TEXT "'")
     26(define-constant SECOND-TEXT "\"")
    2327
    2428(define +dms-regex+
     
    4246(define degree-minute-second-text
    4347  (make-parameter
    44     `(,+dms-degree-char+ ,+dms-minute-char+ ,+dms-second-char+)
     48    `(,DEGREE-TEXT ,MINUTE-TEXT ,SECOND-TEXT)
    4549    (lambda (x)
    4650      (if (and (list? x) (= 3 (length x)))
     
    5660(define (dms->string d m s #!optional lat? leading-dir? (pad ""))
    5761  (if (and (fx= d 0) (fx= m 0) (fx= s 0))
    58     ; return 0,0
     62    ;so 0
    5963    (dms0)
    60     ; construct DMS N/S/E/W
     64    ;construct DMS N/S/E/W
    6165    (let* ((neg? (fx< d 0))
    6266           (d (if neg? (fxneg d) d))
     
    7074; -122°45'10"E => -122.752777777778 even though E
    7175; -122°45'10"W => 122.752777777778 even though W
     76;
    7277(define (string-dms->degree str #!optional lat?)
    7378  (let ((match (irregex-match +dms-regex+ str)))
    74     (if (not match)
    75       (error 'string-dms->degree "improper DMS form" str)
    76       (let* (
    77           (leading-dir (irregex-match-substring match 1) )
    78           (leading-dir (and leading-dir (string-ref leading-dir 0)) )
    79           (d (string->number (irregex-match-substring match 2)) )
    80           (m (string->number (irregex-match-substring match 3)) )
    81           (s (string->number (irregex-match-substring match 4)) )
    82           (trailing-dir (irregex-match-substring match 5) )
    83           (trailing-dir (and trailing-dir (string-ref trailing-dir 0)) )
    84           (dir (or leading-dir trailing-dir) )
    85           ; input string overrides parameters
    86           (lat? (or (ns-dir? dir) lat?) )
    87           (neg? (sw-dir? dir) ) )
    88         (if (and dir (negative? d))
    89           (error 'string-dms->degree "improper DMS sign with direction" str)
    90           (let ((d (if neg? (- d) d)))
    91             (if (and
     79    (unless match
     80      (error 'string-dms->degree "improper DMS form" str) )
     81    (let* (
     82        (leading-dir (irregex-match-substring match 1) )
     83        (leading-dir (and leading-dir (string-ref leading-dir 0)) )
     84        (d (string->number (irregex-match-substring match 2)) )
     85        (m (string->number (irregex-match-substring match 3)) )
     86        (s (string->number (irregex-match-substring match 4)) )
     87        (trailing-dir (irregex-match-substring match 5) )
     88        (trailing-dir (and trailing-dir (string-ref trailing-dir 0)) )
     89        (dir (or leading-dir trailing-dir) )
     90        ; input string overrides parameters
     91        (lat? (or (ns-dir? dir) lat?) )
     92        (neg? (sw-dir? dir) ) )
     93      (when (and dir (negative? d))
     94        (error 'string-dms->degree "improper DMS sign with direction" str) )
     95      (let ((d (if neg? (- d) d)))
     96        (unless (and
    9297                  (if lat?
    9398                    (and (<= -90 d) (<= d 90))
     
    95100                  (and (<= 0 m) (<= m 59))
    96101                  (and (<= 0 s) (<= s 59)) )
    97               (dms->degree d m s)
    98               (error 'string-dms->degree "improper DMS value" str) ) ) ) ) ) ) )
     102          (error 'string-dms->degree "improper DMS value" str) )
     103        (dms->degree d m s) ) ) ) )
    99104
    100105;;
  • release/4/geo-utils/trunk/geo-utils.meta

    r34104 r34129  
    44 (category math)
    55 (author "[[kon lovett]]")
    6  (license "Public Domain")
     6 (license "BSD")
    77 (doc-from-wiki)
    88 (synopsis "Geographic Utilities")
  • release/4/geo-utils/trunk/geo-utils.scm

    r34104 r34129  
    1313  spherical-surface-distance
    1414  great-circle-distance great-circle-distance-radians
    15   #;straight-line-distance
     15  straight-line-distance
    1616  approximate-ellipsoid-distance
     17  ;
    1718  great-circle-azimuth
     19  ;
    1820  great-circle-position )
    1921
    20 (import scheme chicken)
     22(import scheme)
     23
     24(import chicken)
    2125
    2226(use numbers)
     27
    2328(use fp-utils)
    2429
     
    7479;;
    7580
    76 #;
    7781(define (straight-line-distance lat1 lon1 h1 lat2 lon2 h2 #!optional (R EARTH-RADIUS-MILES))
    78 )
     82  ;filler
     83  (pythagorean-distance lat1 lon1 lat2 lon2) )
    7984
    8085;;
     
    117122
    118123(define (great-circle-azimuth lat1 lon1 lat2 lon2 #!optional (prec 5))
    119 
     124  ;
    120125  (define precfact
    121     (fp* 360.0 (fpexpt 10.0 (exact->inexact prec))))
    122 
     126    (fp* 360.0 (fpprecision-factor prec)) )
     127  ;
    123128  (define (clamp n)
    124129    (inexact->exact (fpround (fp* n precfact))) )
    125 
     130  ;
    126131  (let ((ilat1 (clamp lat1))
    127132        (ilon1 (clamp lon1))
     
    134139          180.0
    135140          ; going down or nowhere
    136           0.0) )
     141          0.0 ) )
    137142      (else
    138143        (let ((lat1 (fpdegree->radian lat1))
  • release/4/geo-utils/trunk/geo-utils.setup

    r34104 r34129  
    3737
    3838#|
    39 geo-dms.c:1132:38: error: use of undeclared identifier 'stub253'
     39geo-dms.c:404:38: error: use of undeclared identifier 'stub253'
    4040t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li5),tmp=(C_word)a,a+=3,tmp);
     41                                     ^
     42geo-dms.c:1372:38: error: use of undeclared identifier 'stub253'
     43t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li7),tmp=(C_word)a,a+=3,tmp);
     44                                     ^
     45geo-dms.c:1846:38: error: use of undeclared identifier 'stub253'
     46t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)stub253,a[2]=((C_word)li3),tmp=(C_word)a,a+=3,tmp);
     47                                     ^
     483 errors generated.
    4149|#
  • release/4/geo-utils/trunk/geobox.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  make-geobox
    98  geobox? check-geobox error-geobox
  • release/4/geo-utils/trunk/geopoint-utils.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  geopoint-in-closed-polygon? )
    98
    10 (import scheme chicken)
     9(import scheme)
     10
     11(import chicken)
    1112
    1213(use numbers)
  • release/4/geo-utils/trunk/geopoint.scm

    r34104 r34129  
    55
    66(;export
    7   ;
    87  make-geopoint
    98  geopoint? check-geopoint error-geopoint
     
    1312  geopoint= geopoint< geopoint> geopoint<= geopoint>= )
    1413
    15 (import scheme chicken)
     14(import scheme)
     15
     16(import chicken)
    1617
    1718(use type-checks)
  • release/4/geo-utils/trunk/geopolygon.scm

    r34104 r34129  
    1111  geopolygon-bounding-box )
    1212
    13 (import scheme chicken)
     13(import scheme)
     14
     15(import chicken)
    1416
    1517(use vector-lib)
  • release/4/geo-utils/trunk/tests/run.scm

    r34104 r34129  
    1010(define lat1 33.54187)
    1111(define lon1 -117.78392)
     12
    1213(define lat2 33.54444)
    1314(define lon2 -117.78521)
     
    2324  (print "   ellipsoid-distance: " dea)
    2425  (print "              azimuth: "  a)
    25   (let-values (((lat lon) (great-circle-position lat1 lon1 d a)))
    26     (print "             geopoint test: " lat ", " lon)
    27     (print "             geopoint base: " lat2 ", " lon2)
     26  (receive (lat lon) (great-circle-position lat1 lon1 d a)
     27    (print "        geopoint test: " lat ", " lon)
     28    (print "        geopoint base: " lat2 ", " lon2)
    2829    (test-assert (fp~= lat2 lat 0.009))
    2930    (test-assert (fp~= lon2 lon 0.009)) ) )
Note: See TracChangeset for help on using the changeset viewer.