suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed type errors uncovered by correction to type of exact->inexact (i.e. change to real->double-flonum)

Browse Source
This commit is contained in:
Neil Toronto 2012-06-12 13:26:06 -06:00
parent 4ce4d7531b
commit 7fb38aff44
10 changed files with 87 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/images/private/deep-flomap-render.rkt
View File

@ -88,7 +88,7 @@
;; view and "half" directions
(define-values (hx hy hz) (fl3-half-norm lx ly lz 0.0 0.0 1.0))
;; material properties
(define η2 (exact->inexact (refractive-index)))
(define η2 (real->double-flonum (refractive-index)))
(define η1/η2 (/ 1.0 η2))
;; proportion of diffracted reflection
(define 0.5*v-dot-h (* 0.5 hz))
@ -482,7 +482,7 @@
(trace-directional-light alpha-fm rgb-fm z-fm normal-fm x-min x-max y-min y-max))
;; two Gaussian blurs by half of σ^2 is equivalent to one Gaussian blur by σ^2
(define σ^2 (exact->inexact (sqr (* (min w h) (shadow-blur)))))
(define σ^2 (real->double-flonum (sqr (* (min w h) (shadow-blur)))))
;; blur the shadow to simulate internal scatter
(define shadow-fm

29
collects/images/private/deep-flomap-struct.rkt
View File

@ -81,7 +81,7 @@
(: deep-flomap-smooth-z (deep-flomap Real -> deep-flomap))
(define (deep-flomap-smooth-z dfm σ)
(let ([σ (exact->inexact σ)])
(let ([σ (real->double-flonum σ)])
(match-define (deep-flomap argb-fm z-fm) dfm)
(define new-z-fm (flomap-blur z-fm σ))
(deep-flomap argb-fm new-z-fm)))
@ -117,14 +117,14 @@
(: deep-flomap-bulge (deep-flomap (Flonum Flonum -> Real) -> deep-flomap))
(define (deep-flomap-bulge dfm f)
(inline-deep-flomap-bulge dfm (λ (cx cy) (exact->inexact (f cx cy)))))
(inline-deep-flomap-bulge dfm (λ (cx cy) (real->double-flonum (f cx cy)))))
(: deep-flomap-tilt (deep-flomap Real Real Real Real -> deep-flomap))
(define (deep-flomap-tilt dfm left-z-amt top-z-amt right-z-amt bottom-z-amt)
(let ([l (exact->inexact left-z-amt)]
[t (exact->inexact top-z-amt)]
[r (exact->inexact right-z-amt)]
[b (exact->inexact bottom-z-amt)])
(let ([l (real->double-flonum left-z-amt)]
[t (real->double-flonum top-z-amt)]
[r (real->double-flonum right-z-amt)]
[b (real->double-flonum bottom-z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(define α (/ (+ x 1.0) 2.0))
(define β (/ (+ y 1.0) 2.0))
@ -134,7 +134,7 @@
(: deep-flomap-bulge-round (deep-flomap Real -> deep-flomap))
(define (deep-flomap-bulge-round dfm z-amt)
(let ([z-amt (exact->inexact z-amt)])
(let ([z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(define d^2 (+ (* x x) (* y y)))
(* z-amt (flsqrt (/ (- 2.0 d^2) 2.0))))
@ -142,7 +142,7 @@
(: deep-flomap-bulge-round-rect (deep-flomap Real -> deep-flomap))
(define (deep-flomap-bulge-round-rect dfm z-amt)
(let ([z-amt (exact->inexact z-amt)])
(let ([z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(* z-amt (flsqrt (* (- 1.0 (* x x))
(- 1.0 (* y y))))))
@ -150,7 +150,7 @@
(: deep-flomap-bulge-spheroid (deep-flomap Real -> deep-flomap))
(define (deep-flomap-bulge-spheroid dfm z-amt)
(let ([z-amt (exact->inexact z-amt)])
(let ([z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(define d^2 (+ (* x x) (* y y)))
(if (d^2 . < . 1.0) (* z-amt (flsqrt (- 1.0 d^2))) 0.0))
@ -158,22 +158,22 @@
(: deep-flomap-bulge-horizontal (deep-flomap Real -> deep-flomap))
(define (deep-flomap-bulge-horizontal dfm z-amt)
(let ([z-amt (exact->inexact z-amt)])
(let ([z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(* z-amt (flsqrt (- 1.0 (* x x)))))
(inline-deep-flomap-bulge dfm f)))
(: deep-flomap-bulge-vertical (deep-flomap Real -> deep-flomap))
(define (deep-flomap-bulge-vertical dfm z-amt)
(let ([z-amt (exact->inexact z-amt)])
(let ([z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(* z-amt (flsqrt (- 1.0 (* y y)))))
(inline-deep-flomap-bulge dfm f)))
(: deep-flomap-bulge-ripple (deep-flomap Real Real -> deep-flomap))
(define (deep-flomap-bulge-ripple dfm freq z-amt)
(let ([freq (exact->inexact freq)]
[z-amt (exact->inexact z-amt)])
(let ([freq (real->double-flonum freq)]
[z-amt (real->double-flonum z-amt)])
(define: (f [x : Flonum] [y : Flonum]) : Flonum
(define d^2 (+ (* x x) (* y y)))
(define d (* freq pi (flsqrt d^2)))
@ -241,7 +241,8 @@
[else
(define-values (w1 h1) (deep-flomap-size dfm1))
(define-values (w2 h2) (deep-flomap-size dfm2))
(let ([x1 (exact->inexact x1)] [y1 (exact->inexact y1)])
(let ([x1 (real->double-flonum x1)]
[y1 (real->double-flonum y1)])
;; dfm1 and dfm2 offsets, in final image coordinates
(define dx1 (fl->fx (round (max 0.0 (- x1)))))
(define dy1 (fl->fx (round (max 0.0 (- y1)))))

34
collects/images/private/deep-flomap-untyped-parameters.rkt
View File

@ -20,29 +20,29 @@
(λ () (error 'refractive-index
"`refractive-indexes' does not have a refractive index for ~e"
idx)))]
[else (exact->inexact idx)]))
[else (real->double-flonum idx)]))
(define (list-exact->inexact vs)
(map exact->inexact vs))
(define (list-real->double-flonum vs)
(map real->double-flonum vs))
;; light parameters
(define light-direction (make-parameter '(0.0 -1.0 1.0) list-exact->inexact))
(define light-intensity (make-parameter '(1.0 1.0 1.0) list-exact->inexact))
(define ambient-intensity (make-parameter '(1.0 1.0 1.0) list-exact->inexact))
(define reflected-intensity (make-parameter '(1.0 1.0 1.0) list-exact->inexact))
(define light-direction (make-parameter '(0.0 -1.0 1.0) list-real->double-flonum))
(define light-intensity (make-parameter '(1.0 1.0 1.0) list-real->double-flonum))
(define ambient-intensity (make-parameter '(1.0 1.0 1.0) list-real->double-flonum))
(define reflected-intensity (make-parameter '(1.0 1.0 1.0) list-real->double-flonum))
;; material parameters
(define refractive-index (make-parameter (->refractive-index 'glass) ->refractive-index))
(define ideal-reflectance (make-parameter 1.0 exact->inexact))
(define ideal-transmission (make-parameter 1.0 exact->inexact))
(define transmission-density (make-parameter 0.65 exact->inexact))
(define specular-reflectance (make-parameter 0.15 exact->inexact))
(define specular-roughness (make-parameter 0.15 exact->inexact))
(define specular-purity (make-parameter 1.0 exact->inexact))
(define diffuse-reflectance (make-parameter 0.25 exact->inexact))
(define ambient-reflectance (make-parameter 0.1 exact->inexact))
(define ambient-transmission (make-parameter 0.7 exact->inexact))
(define shadow-blur (make-parameter 0.02 exact->inexact))
(define ideal-reflectance (make-parameter 1.0 real->double-flonum))
(define ideal-transmission (make-parameter 1.0 real->double-flonum))
(define transmission-density (make-parameter 0.65 real->double-flonum))
(define specular-reflectance (make-parameter 0.15 real->double-flonum))
(define specular-roughness (make-parameter 0.15 real->double-flonum))
(define specular-purity (make-parameter 1.0 real->double-flonum))
(define diffuse-reflectance (make-parameter 0.25 real->double-flonum))
(define ambient-reflectance (make-parameter 0.1 real->double-flonum))
(define ambient-transmission (make-parameter 0.7 real->double-flonum))
(define shadow-blur (make-parameter 0.02 real->double-flonum))
(define-parameter-group deep-flomap-lighting
(light-direction light-intensity ambient-intensity reflected-intensity))

18
collects/images/private/flomap-blur.rkt
View File

@ -18,15 +18,15 @@
(case-lambda
[(fm xσ) (flomap-gaussian-blur fm xσ xσ)]
[(fm xσ yσ)
(flomap-gaussian-blur-y (flomap-gaussian-blur-x fm (abs (exact->inexact xσ)))
(abs (exact->inexact yσ)))]))
(flomap-gaussian-blur-y (flomap-gaussian-blur-x fm (abs (real->double-flonum xσ)))
(abs (real->double-flonum yσ)))]))
(: flomap-gaussian-blur-x (flomap Real -> flomap))
(define (flomap-gaussian-blur-x fm σ*)
(cond
[(σ* . = . 0) fm]
[else
(define σ (abs (exact->inexact σ*)))
(define σ (abs (real->double-flonum σ*)))
(define dx-min (fl->fx (floor (* (- 3.0) σ))))
(define dx-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ)))))
(define ss (gaussian-kernel-1d dx-min dx-max σ))
@ -50,7 +50,7 @@
(cond
[(σ* . = . 0) fm]
[else
(define σ (abs (exact->inexact σ*)))
(define σ (abs (real->double-flonum σ*)))
(define dy-min (fl->fx (floor (* (- 3.0) σ))))
(define dy-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ)))))
(define ss (gaussian-kernel-1d dy-min dy-max σ))
@ -197,7 +197,8 @@
(case-lambda
[(fm xr) (flomap-box-blur fm xr xr)]
[(fm xr yr)
(let ([xr (abs (exact->inexact xr))] [yr (abs (exact->inexact yr))])
(let ([xr (abs (real->double-flonum xr))]
[yr (abs (real->double-flonum yr))])
(cond [(and (integer? xr) (integer? yr))
(let ([xr (fl->fx xr)] [yr (fl->fx yr)])
(with-asserts ([xr nonnegative-fixnum?] [yr nonnegative-fixnum?])
@ -207,7 +208,7 @@
(: flomap-box-blur-x (flomap Real -> flomap))
(define (flomap-box-blur-x fm r*)
(define r (abs (exact->inexact r*)))
(define r (abs (real->double-flonum r*)))
(cond
[(integer? r) (let ([r (fl->fx r)])
(with-asserts ([r nonnegative-fixnum?])
@ -234,7 +235,7 @@
(: flomap-box-blur-y (flomap Real -> flomap))
(define (flomap-box-blur-y fm r*)
(define r (abs (exact->inexact r*)))
(define r (abs (real->double-flonum r*)))
(cond
[(integer? r) (let ([r (fl->fx r)])
(with-asserts ([r nonnegative-fixnum?])
@ -312,7 +313,8 @@
(case-lambda
[(fm σ) (flomap-blur fm σ σ)]
[(fm xσ yσ)
(let ([xσ (abs (exact->inexact xσ))] [yσ (abs (exact->inexact yσ))])
(let ([xσ (abs (real->double-flonum xσ))]
[yσ (abs (real->double-flonum yσ))])
(cond
[(and (xσ . >= . 1.5) (yσ . >= . 1.5))
(define xσ^2 (sqr xσ))

2
collects/images/private/flomap-effects.rkt
View File

@ -46,7 +46,7 @@
(define c (flomap-components fm))
(unless (c . > . 0)
(raise-type-error 'flomap-outline "flomap with at least one component" fm))
(let ([amt (exact->inexact amt)])
(let ([amt (real->double-flonum amt)])
(define σ (* 0.5 (max 1.0 amt)))
(define ceiling-amt (fl->fx (ceiling amt)))
(define test-size (fx* 2 (fx+ 1 ceiling-amt)))

8
collects/images/private/flomap-pointwise.rkt
View File

@ -21,7 +21,7 @@
(: flomap-lift ((Float -> Real) -> (flomap -> flomap)))
(define (flomap-lift op)
(inline-flomap-lift (λ (x) (exact->inexact (op x)))))
(inline-flomap-lift (λ (x) (real->double-flonum (op x)))))
(define fmsqrt (inline-flomap-lift flsqrt))
@ -73,15 +73,15 @@
(λ: ([fm1 : (U Real flomap)] [fm2 : (U Real flomap)])
(cond
[(and (real? fm1) (real? fm2)) (raise-two-reals-error name fm1 fm2)]
[(real? fm1) (let ([fm1 (exact->inexact fm1)])
[(real? fm1) (let ([fm1 (real->double-flonum fm1)])
((inline-flomap-lift (λ (v) (f fm1 v))) fm2))]
[(real? fm2) (let ([fm2 (exact->inexact fm2)])
[(real? fm2) (let ([fm2 (real->double-flonum fm2)])
((inline-flomap-lift (λ (v) (f v fm2))) fm1))]
[else ((inline-flomap-lift2* name f) fm1 fm2)])))
(: flomap-lift2 (Symbol (Float Float -> Real) -> ((U Real flomap) (U Real flomap) -> flomap)))
(define (flomap-lift2 name f)
(inline-flomap-lift2 name (λ (x y) (exact->inexact (f x y)))))
(inline-flomap-lift2 name (λ (x y) (real->double-flonum (f x y)))))
(define fm+ (inline-flomap-lift2 'fm+ +))
(define fm- (inline-flomap-lift2 'fm- -))

26
collects/images/private/flomap-resize.rkt
View File

@ -74,8 +74,8 @@
(raise-type-error 'flomap-crop "nonnegative integer" 1 fm width height x-frac y-frac))
(unless (height . >= . 0)
(raise-type-error 'flomap-crop "nonnegative integer" 2 fm width height x-frac y-frac))
(let ([x-frac (exact->inexact x-frac)]
[y-frac (exact->inexact y-frac)])
(let ([x-frac (real->double-flonum x-frac)]
[y-frac (real->double-flonum y-frac)])
(match-define (flomap _ c w h) fm)
(define l-amt (fl->fx (round (* x-frac (fx->fl (fx- width w))))))
(define r-amt (fx- (fx- width w) l-amt))
@ -113,8 +113,8 @@
[(fm x-scale y-scale)
(cond [(< x-scale 0) (raise-type-error 'flomap-scale "nonnegative real" 1 fm x-scale y-scale)]
[(< y-scale 0) (raise-type-error 'flomap-scale "nonnegative real" 2 fm x-scale y-scale)]
[else (flomap-scale-x (flomap-scale-y fm (exact->inexact y-scale))
(exact->inexact x-scale))])]))
[else (flomap-scale-x (flomap-scale-y fm (real->double-flonum y-scale))
(real->double-flonum x-scale))])]))
(: flomap-resize (flomap (Option Integer) (Option Integer) -> flomap))
(define (flomap-resize fm width height)
@ -127,12 +127,12 @@
[width (cond [(= w 0) (error 'flomap-resize
"cannot proportionally scale ~e×~e flomap's height"
w h)]
[else (define s (exact->inexact (/ width w)))
[else (define s (real->double-flonum (/ width w)))
(flomap-resize-x (flomap-scale-y fm s) width)])]
[height (cond [(= h 0) (error 'flomap-resize
"cannot proportionally scale ~e×~e flomap's width"
w h)]
[else (define s (exact->inexact (/ height h)))
[else (define s (real->double-flonum (/ height h)))
(flomap-scale-x (flomap-resize-y fm height) s)])]
[else (error 'flomap-resize "can't happen")]))
@ -140,29 +140,31 @@
(define (flomap-scale-x fm scale)
(match-define (flomap _ c w h) fm)
(cond [(= 0.0 scale) (make-flomap c 0 h)]
[else (let ([scale (abs scale)])
(flomap-scale*-x fm scale (abs (fl->fx (ceiling (* (exact->inexact w) scale))))))]))
[else
(let ([scale (abs scale)])
(flomap-scale*-x fm scale (abs (fl->fx (ceiling (* (real->double-flonum w) scale))))))]))
(: flomap-scale-y (flomap Float -> flomap))
(define (flomap-scale-y fm scale)
(match-define (flomap _ c w h) fm)
(cond [(= 0.0 scale) (make-flomap c w 0)]
[else (let ([scale (abs scale)])
(flomap-scale*-y fm scale (abs (fl->fx (ceiling (* (exact->inexact h) scale))))))]))
[else
(let ([scale (abs scale)])
(flomap-scale*-y fm scale (abs (fl->fx (ceiling (* (real->double-flonum h) scale))))))]))
(: flomap-resize-x (flomap Integer -> flomap))
(define (flomap-resize-x fm width)
(match-define (flomap _ c w h) fm)
(cond [(= 0 width) (make-flomap c 0 h)]
[else (let ([width (abs width)])
(flomap-scale*-x fm (abs (exact->inexact (/ width w))) width))]))
(flomap-scale*-x fm (abs (real->double-flonum (/ width w))) width))]))
(: flomap-resize-y (flomap Integer -> flomap))
(define (flomap-resize-y fm height)
(match-define (flomap _ c w h) fm)
(cond [(= 0 height) (make-flomap c w 0)]
[else (let ([height (abs height)])
(flomap-scale*-y fm (abs (exact->inexact (/ height h))) height))]))
(flomap-scale*-y fm (abs (real->double-flonum (/ height h))) height))]))
;; variance of an unscaled box filter (i.e. f([-1/2,1/2]) = {1}, zero elsewhere)
(define box-filter-variance (/ 1.0 12.0))

12
collects/images/private/flomap-struct.rkt
View File

@ -77,8 +77,8 @@
(define (flomap-bilinear-ref fm k x y)
(match-define (flomap vs c w h) fm)
(cond [(and (k . >= . 0) (k . < . c))
(let ([x (- (exact->inexact x) 0.5)]
[y (- (exact->inexact y) 0.5)])
(let ([x (- (real->double-flonum x) 0.5)]
[y (- (real->double-flonum y) 0.5)])
(cond [(and (x . > . -1.0) (x . < . (->fl w))
(y . > . -1.0) (y . < . (->fl h)))
(define floor-x (floor x))
@ -102,8 +102,8 @@
(: flomap-bilinear-ref* (flomap Real Real -> FlVector))
(define (flomap-bilinear-ref* fm x y)
(match-define (flomap vs c w h) fm)
(let ([x (- (exact->inexact x) 0.5)]
[y (- (exact->inexact y) 0.5)])
(let ([x (- (real->double-flonum x) 0.5)]
[y (- (real->double-flonum y) 0.5)])
(cond [(and (x . > . -1.0) (x . < . (->fl w))
(y . > . -1.0) (y . < . (->fl h)))
(define floor-x (floor x))
@ -141,7 +141,7 @@
(define make-flomap
(case-lambda
[(c w h) (flomap (make-flvector (* c w h)) c w h)]
[(c w h v) (flomap (make-flvector (* c w h) (exact->inexact v)) c w h)]))
[(c w h v) (flomap (make-flvector (* c w h) (real->double-flonum v)) c w h)]))
#;
(: inline-build-flomap (Integer Integer Integer
@ -173,7 +173,7 @@
(Nonnegative-Fixnum Nonnegative-Fixnum Nonnegative-Fixnum -> Real)
-> flomap))
(define (build-flomap c w h f)
(inline-build-flomap c w h (λ (k x y i) (exact->inexact (f k x y)))))
(inline-build-flomap c w h (λ (k x y i) (real->double-flonum (f k x y)))))
#;
(: inline-build-flomap* (Integer Integer Integer

30
collects/images/private/flomap-transform.rkt
View File

@ -65,11 +65,11 @@
[bounded-by : (U 'id 'corners 'edges 'all)])
#:transparent)
(: 2d-mapping-exact->inexact ((Float Float -> (values Real Real))
-> (Float Float -> (values Float Float))))
(define ((2d-mapping-exact->inexact f) x y)
(: 2d-mapping-real->double-flonum ((Float Float -> (values Real Real))
-> (Float Float -> (values Float Float))))
(define ((2d-mapping-real->double-flonum f) x y)
(let-values ([(x y) (f x y)])
(values (exact->inexact x) (exact->inexact y))))
(values (real->double-flonum x) (real->double-flonum y))))
(: make-flomap-2d-mapping (case-> ((Float Float -> (values Real Real))
(Float Float -> (values Real Real))
@ -80,8 +80,8 @@
(define make-flomap-2d-mapping
(case-lambda
[(fun inv) (make-flomap-2d-mapping fun inv 'edges)]
[(fun inv bounded-by) (flomap-2d-mapping (2d-mapping-exact->inexact fun)
(2d-mapping-exact->inexact inv)
[(fun inv bounded-by) (flomap-2d-mapping (2d-mapping-real->double-flonum fun)
(2d-mapping-real->double-flonum inv)
bounded-by)]))
(define-type Flomap-Transform (Integer Integer -> flomap-2d-mapping))
@ -210,8 +210,8 @@
(case-lambda
[(x-scale) (flomap-scale-transform x-scale x-scale)]
[(x-scale y-scale)
(let ([x-scale (exact->inexact x-scale)]
[y-scale (exact->inexact y-scale)])
(let ([x-scale (real->double-flonum x-scale)]
[y-scale (real->double-flonum y-scale)])
(λ (w h)
(flomap-2d-mapping (λ (x y) (values (* x x-scale) (* y y-scale)))
(λ (x y) (values (/ x x-scale) (/ y y-scale)))
@ -219,7 +219,7 @@
(: flomap-rotate-transform (Real -> Flomap-Transform))
(define ((flomap-rotate-transform θ) w h)
(let ([θ (- (exact->inexact θ))])
(let ([θ (- (real->double-flonum θ))])
(define cos-θ (cos θ))
(define sin-θ (sin θ))
(define x-mid (* 0.5 (->fl w)))
@ -239,7 +239,7 @@
(: whirl-function (Real Integer Integer -> (Float Float -> (values Float Float))))
(define (whirl-function θ w h)
(let ([θ (exact->inexact θ)])
(let ([θ (real->double-flonum θ)])
(define x-mid (* 0.5 (->fl w)))
(define y-mid (* 0.5 (->fl h)))
(define-values (x-scale y-scale)
@ -280,31 +280,31 @@
(: perspective-projection (Real -> Projection))
(define ((perspective-projection α) d)
(define f (/ d 2.0 (tan (* 0.5 (exact->inexact α)))))
(define f (/ d 2.0 (tan (* 0.5 (real->double-flonum α)))))
(projection-mapping (λ (ρ) (* (tan ρ) f))
(λ (r) (atan (/ r f)))))
(: linear-projection (Real -> Projection))
(define ((linear-projection α) d)
(define f (/ d (exact->inexact α)))
(define f (/ d (real->double-flonum α)))
(projection-mapping (λ (ρ) (* ρ f))
(λ (r) (/ r f))))
(: orthographic-projection (Real -> Projection))
(define ((orthographic-projection α) d)
(define f (/ d 2.0 (sin (* 0.5 (exact->inexact α)))))
(define f (/ d 2.0 (sin (* 0.5 (real->double-flonum α)))))
(projection-mapping (λ (ρ) (* (sin ρ) f))
(λ (r) (asin (/ r f)))))
(: equal-area-projection (Real -> Projection))
(define ((equal-area-projection α) d)
(define f (/ d 4.0 (sin (* 0.25 (exact->inexact α)))))
(define f (/ d 4.0 (sin (* 0.25 (real->double-flonum α)))))
(projection-mapping (λ (ρ) (* 2.0 (sin (* 0.5 ρ)) f))
(λ (r) (* 2.0 (asin (/ r 2.0 f))))))
(: stereographic-projection (Real -> Projection))
(define ((stereographic-projection α) d)
(define f (/ d 4.0 (tan (* 0.25 (exact->inexact α)))))
(define f (/ d 4.0 (tan (* 0.25 (real->double-flonum α)))))
(projection-mapping (λ (ρ) (* 2.0 (tan (* 0.5 ρ)) f))
(λ (r) (* 2.0 (atan (/ r 2.0 f))))))

5
collects/images/private/flonum.rkt
View File

@ -52,8 +52,9 @@
(define n (vector-length vs))
(define new-vs (make-flvector n 0.0))
(let: loop : FlVector ([k : Nonnegative-Fixnum 0])
(cond [(k . < . n) (unsafe-flvector-set! new-vs k (exact->inexact (unsafe-vector-ref vs k)))
(loop (unsafe-fx+ k 1))]
(cond [(k . < . n)
(unsafe-flvector-set! new-vs k (real->double-flonum (unsafe-vector-ref vs k)))
(loop (unsafe-fx+ k 1))]
[else new-vs])))
(begin-encourage-inline