Changeset 36188 in project


Ignore:
Timestamp:
08/11/18 22:27:30 (13 months ago)
Author:
Kon Lovett
Message:

C5 port work

Location:
release/5/geo-utils/trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • release/5/geo-utils/trunk/geo-dms.scm

    r35995 r36188  
    1919
    2020(import scheme
     21  (chicken base)
    2122  (chicken irregex)
    2223  (chicken fixnum)
    2324  (chicken flonum)
    2425  (chicken type)
    25   ;mathh
    26   ;fp-utils
     26  (only mathh modf)
    2727  ;moremacros
    2828  type-checks
     
    112112(: dms-glyphs (#!optional dms-glyphs -> dms-glyphs))
    113113;
    114 (define-warning-parameter dms-glyphs
     114(define dms-glyphs (make-parameter
    115115  `(,DEGREE-UNIT-GLYPH ,MINUTE-UNIT-GLYPH ,SECOND-UNIT-GLYPH)
    116   dms-glyphs)
     116  (lambda (x)
     117    (if (dms-glyphs? x)
     118      x
     119      (begin
     120        (warning 'dms-glyphs "not a dms-glyphs" x)
     121        (dms-glyphs))))))
    117122
    118123;;
  • release/5/geo-utils/trunk/geo-earth.scm

    r35995 r36188  
    1313
    1414(import scheme
     15  (chicken base)
    1516  (chicken type)
    1617  geo-globe)
  • release/5/geo-utils/trunk/geo-globe.scm

    r35995 r36188  
    2121
    2222(import scheme
     23  (chicken base)
    2324  (chicken type)
    2425  type-checks
  • release/5/geo-utils/trunk/geo-utils.egg

    r35995 r36188  
    99 (dependencies
    1010  (vector-lib "2.0")
    11   ;(moremacros "1.4.2")
    12   ;(mathh "3.1.0")
     11  (mathh "4.0.0")
    1312  (check-errors "3.1.0"))
    1413 (test-dependencies test)
  • release/5/geo-utils/trunk/geo-utils.scm

    r35995 r36188  
    2525  ;fp-utils
    2626  geopoint)
     27
     28;;; FP Utils
     29
     30;;
     31
     32(: fpsqr (float --> float))
     33;
     34(define-inline (fpsqr n)
     35  (fp* n n) )
     36
     37;;
     38
     39(define-constant DEGREE 0.0174532925199432957692369076848861271344) ;pi/180
     40
     41(: fpdegree->radian (float --> float))
     42;
     43(define-inline (fpdegree->radian deg)
     44  (fp* deg DEGREE) )
     45
     46(: fpradian->degree (float --> float))
     47;
     48(define-inline (fpradian->degree rad)
     49  (fp/ rad DEGREE) )
     50
     51;;
     52
     53(: fpprecision-factor ((or float fixnum) #!optional float --> float))
     54;
     55(define-inline (fpprecision-factor p #!optional (base 10.0))
     56  (fpexpt base (exact->inexact p)) )
     57
     58;;;
    2759
    2860(include "geo-constants")
  • release/5/geo-utils/trunk/geobox.scm

    r35995 r36188  
    1313
    1414(import scheme
     15  (chicken base)
    1516  (chicken type)
    1617  type-checks
     
    2526;;
    2627
     28(: check-geopoint-above-left? (symbol * * --> boolean))
     29;
    2730(define (check-geopoint-above-left? loc a b)
    2831  (check-geopoint loc a 'min)
     
    4447
    4548;(: make-geobox (or (geopoint geopoint --> geobox) (number number number number --> geobox)))
     49;
    4650(define make-geobox
    4751  (case-lambda
  • release/5/geo-utils/trunk/geopolygon.scm

    r35995 r36188  
    1414
    1515(import scheme
     16  (chicken base)
    1617  (chicken fixnum)
    1718  (chicken type)
  • release/5/geo-utils/trunk/tests/geo-utils-test.scm

    r35995 r36188  
    1 ;;;; geo-utils-test.scm
     1;;;; geo-utils-test.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
    23;;;; Kon Lovett, May '17
    34
    4 (use test)
     5(import test)
     6
     7(test-begin "Geo Utils")
    58
    69;;;
    710
     11(import (chicken flonum))
     12
     13;;; FP Utils
     14
    815;;
    916
    10 (test-begin "geo-utils")
     17(: fp~= (float float #!optional float --> boolean))
     18;
     19(define (fp~= x y #!optional (eps flonum-epsilon))
     20  (let (
     21    (diff (fp- x y)) )
     22    (or
     23      ;(fpzero? diff) ;really, how often is this true?
     24      (fp<= (fpabs diff) eps) ) ) )
    1125
    12 (use fp-utils)
     26;;;
    1327
    14 (use geo-utils)
     28(import geo-utils)
    1529
    1630(define lat1 33.54187)
     
    4256;;
    4357
    44 (use geo-dms)
     58(import geo-dms)
    4559
    4660(test-group "geo-dms"
     
    5771;;
    5872
    59 (use geopoint)
     73(import geopoint)
    6074
    6175(test-group "geopoint"
     
    7690;;
    7791
    78 (use geopolygon)
    79 (use geopoint-utils)
     92(import geopolygon)
     93(import geopoint-utils)
    8094
    8195(test-group "geopolygon"
     
    97111;;
    98112
    99 (use geobox)
     113(import geobox)
    100114
    101115(test-group "geobox"
     
    118132;;
    119133
    120 (use (prefix geo-globe globe:) geo-earth)
     134(import (prefix geo-globe globe:) geo-earth)
    121135
    122136(test-group "geo-globe"
     
    143157)
    144158
    145 ;;
    146 
    147 (test-end "geo-utils")
    148 
    149159;;;
    150160
     161(test-end "Geo Utils")
     162
    151163(test-exit)
    152 
  • release/5/geo-utils/trunk/tests/run.scm

    r35995 r36188  
    44;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    55
    6 (use files)
     6(import
     7  (only (chicken pathname) make-pathname)
     8  (only (chicken process) system)
     9  (only (chicken process-context) argv)
     10  (only (chicken format) format))
     11
     12(define *args* (argv))
    713
    814;no -disable-interrupts
    9 (define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    10 
    11 (define *args* (argv))
     15(define *csc-options* "-inline-global \
     16  -specialize -optimize-leaf-routines -clustering -lfa2 \
     17  -local -inline \
     18  -no-trace -no-lambda-info \
     19  -unsafe")
    1220
    1321(define (test-name #!optional (eggnam EGG-NAME))
     
    2937(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    3038  (let ((tstnam (test-name eggnam)))
    31     (print "*** csi ***")
     39    (format #t "*** csi ***~%")
    3240    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    3341    (newline)
    34     (print "*** csc (" cscopts ") ***")
     42    (format #t "*** csc ~s ***~%" cscopts)
    3543    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    3644    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
Note: See TracChangeset for help on using the changeset viewer.