Finalized and documented flomap transforms and effects
This commit is contained in:
Neil Toronto
parent
2b9912ea9f
commit
18fa552723
|
|
@ -76,7 +76,9 @@
|
|||
[fm (if trim? (flomap-trim fm) fm)]
|
||||
[fm (flomap-resize fm #f (- height (* 2 ceiling-amt)))]
|
||||
[fm (flomap-inset fm ceiling-amt)]
|
||||
[fm (if (outline . > . 0) (flomap-outlined fm outline (flvector r g b)) fm)])
|
||||
[fm (cond [(outline . > . 0)
|
||||
(flomap-cc-superimpose (flomap-outline fm outline (flvector 1.0 r g b)) fm)]
|
||||
[else fm])])
|
||||
(flomap-render-icon fm material)))))
|
||||
|
||||
(define recycle-path-commands
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@
|
|||
(define dx-start (fx- (fxmax (fx+ x dx-min) 0) x))
|
||||
(define dx-end (fx- (fxmin (fx+ x dx-max) w) x))
|
||||
(define j (fx+ i (fx* c dx-start)))
|
||||
(let: src-loop : Flonum ([sum : Flonum 0.0] [dx : Fixnum dx-start] [j : Fixnum j])
|
||||
(let: src-loop : Float ([sum : Float 0.0] [dx : Fixnum dx-start] [j : Fixnum j])
|
||||
(cond [(dx . fx< . dx-end) (define s (unsafe-flvector-ref ss (fx- dx dx-min)))
|
||||
(src-loop (+ sum (* s (unsafe-flvector-ref vs j)))
|
||||
(fx+ dx 1)
|
||||
|
|
@ -63,19 +63,19 @@
|
|||
(define dy-start (fx- (fxmax (fx+ y dy-min) 0) y))
|
||||
(define dy-end (fx- (fxmin (fx+ y dy-max) h) y))
|
||||
(define j (fx+ i (fx* cw dy-start)))
|
||||
(let: src-loop : Flonum ([sum : Flonum 0.0] [dy : Fixnum dy-start] [j : Fixnum j])
|
||||
(let: src-loop : Float ([sum : Float 0.0] [dy : Fixnum dy-start] [j : Fixnum j])
|
||||
(cond [(dy . fx< . dy-end) (define s (unsafe-flvector-ref ss (fx- dy dy-min)))
|
||||
(src-loop (+ sum (* s (unsafe-flvector-ref vs j)))
|
||||
(fx+ dy 1)
|
||||
(fx+ j cw))]
|
||||
[else sum]))))]))
|
||||
|
||||
(: gaussian-kernel-1d (Fixnum Fixnum Flonum -> FlVector))
|
||||
(: gaussian-kernel-1d (Fixnum Fixnum Float -> FlVector))
|
||||
(define (gaussian-kernel-1d mn mx σ)
|
||||
(define n (fx- mx mn))
|
||||
(define ys (make-flvector n))
|
||||
(define sum
|
||||
(let: loop : Flonum ([i : Fixnum 0] [sum : Flonum 0.0])
|
||||
(let: loop : Float ([i : Fixnum 0] [sum : Float 0.0])
|
||||
(cond [(i . fx< . n) (define v (flgaussian (fx->fl (fx+ i mn)) σ))
|
||||
(flvector-set! ys i v)
|
||||
(loop (fx+ i 1) (+ sum v))]
|
||||
|
|
@ -157,7 +157,7 @@
|
|||
|
||||
(: raw-flomap-integral-sum (FlVector Integer Integer Integer
|
||||
Integer Integer Integer Integer Integer
|
||||
-> Flonum))
|
||||
-> Float))
|
||||
(define (raw-flomap-integral-sum vs c w h k x-start y-start x-end y-end)
|
||||
(define w-1 (fx- w 1))
|
||||
(define h-1 (fx- h 1))
|
||||
|
|
@ -171,7 +171,7 @@
|
|||
(flvector-ref vs (coords->index c w k x2 y1)))))
|
||||
|
||||
(: raw-flomap-integral-x-sum (FlVector Integer Integer
|
||||
Integer Integer Integer Integer -> Flonum))
|
||||
Integer Integer Integer Integer -> Float))
|
||||
(define (raw-flomap-integral-x-sum vs c w k x-start x-end y)
|
||||
(define w-1 (fx- w 1))
|
||||
(define x1 (fxmax 0 (fxmin x-start w-1)))
|
||||
|
|
@ -180,7 +180,7 @@
|
|||
(flvector-ref vs (coords->index c w k x1 y))))
|
||||
|
||||
(: raw-flomap-integral-y-sum (FlVector Integer Integer Integer
|
||||
Integer Integer Integer Integer -> Flonum))
|
||||
Integer Integer Integer Integer -> Float))
|
||||
(define (raw-flomap-integral-y-sum vs c w h k x y-start y-end)
|
||||
(define h-1 (fx- h 1))
|
||||
(define y1 (fxmax 0 (fxmin y-start h-1)))
|
||||
|
|
@ -298,11 +298,11 @@
|
|||
;; ===================================================================================================
|
||||
;; Default blur
|
||||
|
||||
(: box-radius->variance (Flonum -> Flonum))
|
||||
(: box-radius->variance (Float -> Float))
|
||||
(define (box-radius->variance r)
|
||||
(* 1/12 (sqr (+ 1 (* 2 r)))))
|
||||
|
||||
(: variance->box-radius (Flonum -> Flonum))
|
||||
(: variance->box-radius (Float -> Float))
|
||||
(define (variance->box-radius σ^2)
|
||||
(* 1/2 (- (flsqrt (* 12 σ^2)) 1)))
|
||||
|
||||
|
|
@ -326,7 +326,7 @@
|
|||
(flomap-blur-x (flomap-blur-y fm yσ) xσ)]))]))
|
||||
|
||||
(: make-flomap-blur-dimension
|
||||
((flomap Flonum -> flomap) (flomap Flonum -> flomap) -> (flomap Flonum -> flomap)))
|
||||
((flomap Float -> flomap) (flomap Float -> flomap) -> (flomap Float -> flomap)))
|
||||
(define ((make-flomap-blur-dimension gaussian-blur box-blur) fm σ)
|
||||
(cond
|
||||
[(σ . = . 0.0) fm]
|
||||
|
|
|
|||
|
|
@ -8,12 +8,6 @@
|
|||
|
||||
(provide bitmap->flomap flomap->bitmap draw-flomap)
|
||||
|
||||
(define-syntax-rule (unsafe-fl->byte y)
|
||||
(let ([x (unsafe-flmax 0.0 (unsafe-flmin 255.0 y))])
|
||||
(cond [(and (x . unsafe-fl> . -inf.0) (x . unsafe-fl< . +inf.0))
|
||||
(unsafe-fl->fx (unsafe-flround x))]
|
||||
[else 0.0])))
|
||||
|
||||
(define (bitmap->flomap bm)
|
||||
(unless (is-a? bm bitmap%)
|
||||
(raise-type-error 'bitmap->flomap "bitmap% instance" bm))
|
||||
|
|
@ -40,6 +34,11 @@
|
|||
|
||||
argb-fm)
|
||||
|
||||
(define (unsafe-fl->byte x)
|
||||
(unsafe-fl->fx
|
||||
(unsafe-flround
|
||||
(unsafe-flmax 0.0 (unsafe-flmin 255.0 (unsafe-fl* x 255.0))))))
|
||||
|
||||
(define (flomap->bitmap fm)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(let* ([fm (case c
|
||||
|
|
@ -64,10 +63,10 @@
|
|||
(define r (unsafe-flvector-ref vs i1))
|
||||
(define g (unsafe-flvector-ref vs i2))
|
||||
(define b (unsafe-flvector-ref vs i3))
|
||||
(unsafe-bytes-set! bs i0 (unsafe-fl->byte (unsafe-fl* 255.0 a)))
|
||||
(unsafe-bytes-set! bs i1 (unsafe-fl->byte (unsafe-fl* 255.0 r)))
|
||||
(unsafe-bytes-set! bs i2 (unsafe-fl->byte (unsafe-fl* 255.0 g)))
|
||||
(unsafe-bytes-set! bs i3 (unsafe-fl->byte (unsafe-fl* 255.0 b))))
|
||||
(unsafe-bytes-set! bs i0 (unsafe-fl->byte a))
|
||||
(unsafe-bytes-set! bs i1 (unsafe-fl->byte r))
|
||||
(unsafe-bytes-set! bs i2 (unsafe-fl->byte g))
|
||||
(unsafe-bytes-set! bs i3 (unsafe-fl->byte b)))
|
||||
|
||||
(define bm (make-bitmap w h))
|
||||
(send bm set-argb-pixels 0 0 w h bs #t #t)
|
||||
|
|
|
|||
|
|
@ -3,20 +3,27 @@
|
|||
(require racket/math racket/match racket/list
|
||||
"flonum.rkt"
|
||||
"flomap-struct.rkt"
|
||||
"flomap-stats.rkt"
|
||||
"flomap-pointwise.rkt"
|
||||
"flomap-blur.rkt"
|
||||
"flomap-composite.rkt"
|
||||
"flomap-resize.rkt"
|
||||
"flomap-transform.rkt")
|
||||
|
||||
(provide flomap-outline flomap-outlined
|
||||
flomap-shadow flomap-shadowed
|
||||
(provide flomap-shadow flomap-outline
|
||||
flomap-whirl-morph)
|
||||
|
||||
(: colorize-alpha (flomap (U (Vectorof Real) FlVector) -> flomap))
|
||||
(define (colorize-alpha fm vs)
|
||||
(match-define (flomap _ 1 w h) fm)
|
||||
(flomap-append-components fm (fm* fm (make-flomap* w h vs))))
|
||||
(fm* fm (make-flomap* w h vs)))
|
||||
|
||||
(: shadow-color (Integer (Option (U (Vectorof Real) FlVector)) -> (U (Vectorof Real) FlVector)))
|
||||
(define (shadow-color c color)
|
||||
(cond [color color]
|
||||
[else (define vs (make-flvector c))
|
||||
(flvector-set! vs 0 1.0)
|
||||
vs]))
|
||||
|
||||
(: flomap-shadow (case-> (flomap Real -> flomap)
|
||||
(flomap Real (Option (U (Vectorof Real) FlVector)) -> flomap)))
|
||||
|
|
@ -24,18 +31,11 @@
|
|||
(case-lambda
|
||||
[(fm σ) (flomap-shadow fm σ #f)]
|
||||
[(fm σ color)
|
||||
(match-define (flomap _ c w h) fm)
|
||||
(cond [(c . = . 0) fm]
|
||||
[else (define alpha-fm (flomap-ref-component fm 0))
|
||||
(define color-vs (if color color (make-flvector (- c 1) 0.0)))
|
||||
(colorize-alpha (flomap-blur alpha-fm σ) color-vs)])]))
|
||||
|
||||
(: flomap-shadowed (case-> (flomap Real -> flomap)
|
||||
(flomap Real (Option (U (Vectorof Real) FlVector)) -> flomap)))
|
||||
(define flomap-shadowed
|
||||
(case-lambda
|
||||
[(fm σ) (flomap-shadowed fm σ #f)]
|
||||
[(fm σ c) (flomap-cc-superimpose (flomap-shadow fm σ c) fm)]))
|
||||
(define c (flomap-components fm))
|
||||
(cond [(= c 0) (raise-type-error 'flomap-shadow "flomap with at least one component" fm)]
|
||||
[(= c 1) (flomap-blur fm σ)]
|
||||
[else (colorize-alpha (flomap-blur (flomap-ref-component fm 0) σ)
|
||||
(shadow-color c color))])]))
|
||||
|
||||
(: flomap-outline (case-> (flomap Real -> flomap)
|
||||
(flomap Real (Option (U (Vectorof Real) FlVector)) -> flomap)))
|
||||
|
|
@ -43,29 +43,33 @@
|
|||
(case-lambda
|
||||
[(fm amt) (flomap-outline fm amt #f)]
|
||||
[(fm amt color)
|
||||
(match-define (flomap _ c w h) fm)
|
||||
(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)])
|
||||
(define σ (* 0.5 (max 1.0 amt)))
|
||||
(define ceiling-amt (fl->fx (ceiling amt)))
|
||||
(define test-size (fx* 2 (fx+ 1 ceiling-amt)))
|
||||
(define test-mid (fxquotient test-size 2))
|
||||
(define test-fm (inline-build-flomap 1 test-size test-size
|
||||
(λ (k x y i) (if (x . fx>= . test-mid) 1.0 0.0))))
|
||||
(define blur-fm (flomap-blur test-fm σ))
|
||||
(define v-max (flomap-bilinear-ref blur-fm 0 (+ 0.5 (- test-mid amt)) test-mid))
|
||||
(define v-min (flomap-bilinear-ref blur-fm 0 (+ 0.5 (- test-mid amt 1)) test-mid))
|
||||
(define alpha-fm (flomap-ref-component fm 0))
|
||||
(define new-alpha-fm (fmmax 0.0 (fmmin 1.0 (fm/ (fm- (flomap-blur alpha-fm σ) v-min)
|
||||
(- v-max v-min)))))
|
||||
(define color-vs (if color color (make-flvector (- c 1) 0.0)))
|
||||
(colorize-alpha new-alpha-fm color-vs))]))
|
||||
|
||||
(: flomap-outlined (case-> (flomap Real -> flomap)
|
||||
(flomap Real (Option (U (Vectorof Real) FlVector)) -> flomap)))
|
||||
(define flomap-outlined
|
||||
(case-lambda
|
||||
[(fm amt) (flomap-outlined fm amt #f)]
|
||||
[(fm amt c) (flomap-cc-superimpose (flomap-outline fm amt c) fm)]))
|
||||
(define-values (a-min a-max) (flomap-extreme-values alpha-fm))
|
||||
(define a-size (- a-max a-min))
|
||||
(define test-fm (inline-build-flomap 1 test-size 1
|
||||
(λ (k x y i) (if (x . fx>= . test-mid) a-max a-min))))
|
||||
(define blur-test-fm (flomap-blur-x test-fm σ))
|
||||
(define v-min (flomap-bilinear-ref blur-test-fm 0 (+ 0.5 (- test-mid amt 1.0)) 0.5))
|
||||
(define v-max (flomap-bilinear-ref blur-test-fm 0 (+ 0.5 (- test-mid amt)) 0.5))
|
||||
(define av-scale (/ a-size (- v-max v-min)))
|
||||
(let* ([outline-fm (flomap-blur alpha-fm σ)]
|
||||
[outline-fm ((inline-flomap-lift
|
||||
(λ (v) (+ a-min (max 0.0 (min a-size (* av-scale (- v v-min)))))))
|
||||
outline-fm)]
|
||||
[outline-fm ((inline-flomap-lift2
|
||||
'subtract-alpha
|
||||
(λ (o a) (if (= a 1.0) 0.0 (/ (- o a) (- 1.0 a)))))
|
||||
outline-fm alpha-fm)])
|
||||
(define color-vs (shadow-color c color))
|
||||
(colorize-alpha outline-fm color-vs)))]))
|
||||
|
||||
(define blend-start 1/3)
|
||||
(define blend-end 2/3)
|
||||
|
|
@ -74,22 +78,22 @@
|
|||
(define (flomap-whirl-morph fm1 fm2)
|
||||
(define w (max (flomap-width fm1) (flomap-width fm2)))
|
||||
(define h (max (flomap-height fm1) (flomap-height fm2)))
|
||||
(let ([fm1 (flomap-crop fm1 w h 1/2 1/2)]
|
||||
[fm2 (flomap-crop fm2 w h 1/2 1/2)])
|
||||
(let ([fm1 (flomap-cc-crop fm1 w h)]
|
||||
[fm2 (flomap-cc-crop fm2 w h)])
|
||||
|
||||
(define: (whirled-fm1 [t : Real]) : flomap
|
||||
(define t1 (sqr t))
|
||||
(define trans1
|
||||
(transform-compose (whirl-and-pinch-transform (* t1 (* -8 pi)) (* -4 t1) 1)
|
||||
(rotate-transform (* t1 (* -1 pi)))))
|
||||
(flomap-transform fm1 trans1 0 w 0 h))
|
||||
(flomap-transform-compose (flomap-rotate-transform (* t1 (* -1 pi)))
|
||||
(flomap-whirl-transform (* t1 (* -8 pi)))))
|
||||
(flomap-transform fm1 trans1 0 0 w h))
|
||||
|
||||
(define: (whirled-fm2 [t : Real]) : flomap
|
||||
(define t2 (sqr (- 1 t)))
|
||||
(define trans2
|
||||
(transform-compose (rotate-transform (* t2 (* 1 pi)))
|
||||
(whirl-and-pinch-transform (* t2 (* 8 pi)) (* -4 t2) 1)))
|
||||
(flomap-transform fm2 trans2 0 w 0 h))
|
||||
(flomap-transform-compose (flomap-rotate-transform (* t2 (* 1 pi)))
|
||||
(flomap-whirl-transform (* t2 (* 8 pi)))))
|
||||
(flomap-transform fm2 trans2 0 0 w h))
|
||||
|
||||
(λ (t)
|
||||
(cond [(t . <= . 0) fm1]
|
||||
|
|
|
|||
|
|
@ -12,14 +12,14 @@
|
|||
;; ===================================================================================================
|
||||
;; Unary
|
||||
|
||||
;(: inline-flomap-lift ((Flonum -> Flonum) -> (flomap -> flomap)))
|
||||
;(: inline-flomap-lift ((Float -> Float) -> (flomap -> flomap)))
|
||||
(define-syntax-rule (inline-flomap-lift f)
|
||||
(λ: ([fm : flomap])
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(flomap (inline-build-flvector (* c w h) (λ (i) (f (flvector-ref vs i))))
|
||||
c w h)))
|
||||
|
||||
(: flomap-lift ((Flonum -> Real) -> (flomap -> flomap)))
|
||||
(: flomap-lift ((Float -> Real) -> (flomap -> flomap)))
|
||||
(define (flomap-lift op)
|
||||
(inline-flomap-lift (λ (x) (exact->inexact (op x)))))
|
||||
|
||||
|
|
@ -44,7 +44,7 @@
|
|||
c1 c2))
|
||||
|
||||
#;
|
||||
(: inline-flomap-lift2* (Symbol (Flonum Flonum -> Flonum)
|
||||
(: inline-flomap-lift2* (Symbol (Float Float -> Float)
|
||||
-> (flomap flomap -> flomap)))
|
||||
(define-syntax-rule (inline-flomap-lift2* name f)
|
||||
(λ: ([fm1 : flomap] [fm2 : flomap])
|
||||
|
|
@ -67,7 +67,7 @@
|
|||
[else (raise-component-error name c1 c2)])))
|
||||
|
||||
#;
|
||||
(: inline-flomap-lift2 (Symbol (Flonum Flonum -> Flonum)
|
||||
(: inline-flomap-lift2 (Symbol (Float Float -> Float)
|
||||
-> ((U Real flomap) (U Real flomap) -> flomap)))
|
||||
(define-syntax-rule (inline-flomap-lift2 name f)
|
||||
(λ: ([fm1 : (U Real flomap)] [fm2 : (U Real flomap)])
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
((inline-flomap-lift (λ (v) (f v fm2))) fm1))]
|
||||
[else ((inline-flomap-lift2* name f) fm1 fm2)])))
|
||||
|
||||
(: flomap-lift2 (Symbol (Flonum Flonum -> Real) -> ((U Real flomap) (U Real flomap) -> flomap)))
|
||||
(: 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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -136,14 +136,14 @@
|
|||
(flomap-scale-x (flomap-resize-y fm height) s)])]
|
||||
[else (error 'flomap-resize "can't happen")]))
|
||||
|
||||
(: flomap-scale-x (flomap Flonum -> flomap))
|
||||
(: flomap-scale-x (flomap Float -> flomap))
|
||||
(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))))))]))
|
||||
|
||||
(: flomap-scale-y (flomap Flonum -> flomap))
|
||||
(: 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)]
|
||||
|
|
@ -171,13 +171,13 @@
|
|||
|
||||
;; calculates the standard deviation of downscaling blur, assuming linear interpolation will be
|
||||
;; carried out on the blurred image
|
||||
(: stddev-for-scale (Flonum -> Flonum))
|
||||
(: stddev-for-scale (Float -> Float))
|
||||
(define (stddev-for-scale scale)
|
||||
(define var (- (/ box-filter-variance (sqr scale))
|
||||
triangle-filter-variance))
|
||||
(flsqrt (max 0.0 var)))
|
||||
|
||||
(: flomap-scale*-x (flomap Flonum Exact-Nonnegative-Integer -> flomap))
|
||||
(: flomap-scale*-x (flomap Float Exact-Nonnegative-Integer -> flomap))
|
||||
(define (flomap-scale*-x fm scale width)
|
||||
(cond [(scale . = . 1.0) fm]
|
||||
[(scale . > . 1.0) (flomap-scale*-x/linear fm scale width)]
|
||||
|
|
@ -185,7 +185,7 @@
|
|||
(flomap-gaussian-blur-x fm (stddev-for-scale scale)))
|
||||
(flomap-scale*-x/linear low-res-fm scale width)]))
|
||||
|
||||
(: flomap-scale*-y (flomap Flonum Exact-Nonnegative-Integer -> flomap))
|
||||
(: flomap-scale*-y (flomap Float Exact-Nonnegative-Integer -> flomap))
|
||||
(define (flomap-scale*-y fm scale height)
|
||||
(cond [(scale . = . 1.0) fm]
|
||||
[(scale . > . 1.0) (flomap-scale*-y/linear fm scale height)]
|
||||
|
|
@ -193,7 +193,7 @@
|
|||
(flomap-gaussian-blur-y fm (stddev-for-scale scale)))
|
||||
(flomap-scale*-y/linear low-res-fm scale height)]))
|
||||
|
||||
(: flomap-scale*-x/linear (flomap Flonum Exact-Nonnegative-Integer -> flomap))
|
||||
(: flomap-scale*-x/linear (flomap Float Exact-Nonnegative-Integer -> flomap))
|
||||
(define (flomap-scale*-x/linear fm s new-w)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(define w-1 (unsafe-fx+ w -1))
|
||||
|
|
@ -212,7 +212,7 @@
|
|||
[else (flvector-ref vs (unsafe-fx+ i0 c))]))
|
||||
(fl-convex-combination v0 v1 (- scaled-x floor-scaled-x))]))))
|
||||
|
||||
(: flomap-scale*-y/linear (flomap Flonum Exact-Nonnegative-Integer -> flomap))
|
||||
(: flomap-scale*-y/linear (flomap Float Exact-Nonnegative-Integer -> flomap))
|
||||
(define (flomap-scale*-y/linear fm s new-h)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(define h-1 (unsafe-fx+ h -1))
|
||||
|
|
|
|||
|
|
@ -7,20 +7,21 @@
|
|||
(provide flomap-min-value flomap-max-value flomap-extreme-values
|
||||
flomap-nonzero-rect)
|
||||
|
||||
(: flomap-min-value (flomap -> Flonum))
|
||||
(: flomap-min-value (flomap -> Float))
|
||||
(define (flomap-min-value fm)
|
||||
(for/fold ([v-min +inf.0]) ([v (in-flvector (flomap-values fm))])
|
||||
(min v-min v)))
|
||||
|
||||
(: flomap-max-value (flomap -> Flonum))
|
||||
(: flomap-max-value (flomap -> Float))
|
||||
(define (flomap-max-value fm)
|
||||
(for/fold ([v-max -inf.0]) ([v (in-flvector (flomap-values fm))])
|
||||
(max v-max v)))
|
||||
|
||||
(: flomap-extreme-values (flomap -> (values Flonum Flonum)))
|
||||
(: flomap-extreme-values (flomap -> (values Float Float)))
|
||||
(define (flomap-extreme-values fm)
|
||||
(for/fold: ([v-min : Flonum +inf.0] [v-max : Flonum -inf.0]
|
||||
) ([v : Flonum (in-flvector (flomap-values fm))])
|
||||
(for/fold: ([v-min : Float +inf.0]
|
||||
[v-max : Float -inf.0]
|
||||
) ([v : Float (in-flvector (flomap-values fm))])
|
||||
(values (min v-min v) (max v-max v))))
|
||||
|
||||
(: flomap-nonzero-rect (flomap -> (values Nonnegative-Fixnum Nonnegative-Fixnum
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@
|
|||
(define (coords->index c w k x y)
|
||||
(fx+ k (fx* c (fx+ x (fx* y w)))))
|
||||
|
||||
(: unsafe-flomap-ref (FlVector Integer Integer Integer Integer Integer Integer -> Flonum))
|
||||
(: unsafe-flomap-ref (FlVector Integer Integer Integer Integer Integer Integer -> Float))
|
||||
(define (unsafe-flomap-ref vs c w h k x y)
|
||||
(cond [(and (x . fx>= . 0) (x . fx< . w)
|
||||
(y . fx>= . 0) (y . fx< . h))
|
||||
|
|
@ -59,7 +59,7 @@
|
|||
point-vs]
|
||||
[else (make-flvector c 0.0)]))
|
||||
|
||||
(: flomap-ref (flomap Integer Integer Integer -> Flonum))
|
||||
(: flomap-ref (flomap Integer Integer Integer -> Float))
|
||||
(define (flomap-ref fm k x y)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(unless (and (k . >= . 0) (k . < . c))
|
||||
|
|
@ -73,7 +73,7 @@
|
|||
|
||||
) ; begin-encourage-inline
|
||||
|
||||
(: flomap-bilinear-ref (flomap Integer Real Real -> Flonum))
|
||||
(: flomap-bilinear-ref (flomap Integer Real Real -> Float))
|
||||
(define (flomap-bilinear-ref fm k x y)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(cond [(and (k . >= . 0) (k . < . c))
|
||||
|
|
@ -146,7 +146,7 @@
|
|||
#;
|
||||
(: inline-build-flomap (Integer Integer Integer
|
||||
(Nonnegative-Fixnum Nonnegative-Fixnum Nonnegative-Fixnum
|
||||
Nonnegative-Fixnum -> Flonum)
|
||||
Nonnegative-Fixnum -> Float)
|
||||
-> flomap))
|
||||
(define-syntax-rule (inline-build-flomap components width height f)
|
||||
(let: ([c : Integer components]
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang typed/racket/base
|
||||
|
||||
(require racket/match racket/math
|
||||
(require racket/match racket/math racket/bool
|
||||
(only-in racket/unsafe/ops
|
||||
unsafe-flvector-ref
|
||||
unsafe-fx+ unsafe-fx-)
|
||||
|
|
@ -9,10 +9,19 @@
|
|||
|
||||
(provide flomap-flip-horizontal flomap-flip-vertical flomap-transpose
|
||||
flomap-cw-rotate flomap-ccw-rotate flomap-rotate
|
||||
(struct-out invertible-2d-mapping) Flomap-Transform
|
||||
transform-compose rotate-transform whirl-and-pinch-transform
|
||||
flomap-transform
|
||||
)
|
||||
flomap-2d-mapping flomap-2d-mapping-fun flomap-2d-mapping-inv
|
||||
flomap-2d-mapping-bounded-by make-flomap-2d-mapping
|
||||
Flomap-Transform
|
||||
flomap-transform flomap-transform-bounds
|
||||
flomap-id-transform flomap-rotate-transform flomap-scale-transform flomap-whirl-transform
|
||||
flomap-transform-compose
|
||||
perspective-projection linear-projection orthographic-projection
|
||||
equal-area-projection stereographic-projection flomap-projection-transform
|
||||
flomap-fisheye-transform
|
||||
Projection (struct-out projection-mapping))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Basic transformations
|
||||
|
||||
(: flomap-flip-horizontal (flomap -> flomap))
|
||||
(define (flomap-flip-horizontal fm)
|
||||
|
|
@ -46,106 +55,191 @@
|
|||
|
||||
(: flomap-rotate (flomap Real -> flomap))
|
||||
(define (flomap-rotate fm θ)
|
||||
(flomap-transform fm (rotate-transform θ)))
|
||||
(flomap-transform fm (flomap-rotate-transform θ)))
|
||||
|
||||
(struct: invertible-2d-mapping ([fun : (Flonum Flonum -> (values Flonum Flonum))]
|
||||
[inv : (Flonum Flonum -> (values Flonum Flonum))]))
|
||||
;; ===================================================================================================
|
||||
;; Data types
|
||||
|
||||
(define-type Flomap-Transform (Integer Integer -> invertible-2d-mapping))
|
||||
(struct: flomap-2d-mapping ([fun : (Float Float -> (values Float Float))]
|
||||
[inv : (Float Float -> (values Float Float))]
|
||||
[bounded-by : (U 'id 'corners 'edges 'all)])
|
||||
#:transparent)
|
||||
|
||||
(: transform-compose (Flomap-Transform Flomap-Transform -> Flomap-Transform))
|
||||
(define ((transform-compose t1 t2) w h)
|
||||
(match-define (invertible-2d-mapping f1 g1) (t1 w h))
|
||||
(match-define (invertible-2d-mapping f2 g2) (t2 w h))
|
||||
(invertible-2d-mapping (λ: ([x : Flonum] [y : Flonum])
|
||||
(let-values ([(x y) (f2 x y)])
|
||||
(f1 x y)))
|
||||
(λ: ([x : Flonum] [y : Flonum])
|
||||
(let-values ([(x y) (g1 x y)])
|
||||
(g2 x y)))))
|
||||
(: 2d-mapping-exact->inexact ((Float Float -> (values Real Real))
|
||||
-> (Float Float -> (values Float Float))))
|
||||
(define ((2d-mapping-exact->inexact f) x y)
|
||||
(let-values ([(x y) (f x y)])
|
||||
(values (exact->inexact x) (exact->inexact y))))
|
||||
|
||||
(: flomap-transform (case-> (flomap Flomap-Transform -> flomap)
|
||||
(flomap Flomap-Transform Real Real Real Real -> flomap)))
|
||||
(define flomap-transform
|
||||
(: make-flomap-2d-mapping (case-> ((Float Float -> (values Real Real))
|
||||
(Float Float -> (values Real Real))
|
||||
-> flomap-2d-mapping)
|
||||
((Float Float -> (values Real Real))
|
||||
(Float Float -> (values Real Real))
|
||||
(U 'id 'corners 'edges 'all) -> flomap-2d-mapping)))
|
||||
(define make-flomap-2d-mapping
|
||||
(case-lambda
|
||||
[(fm t)
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(match-define (invertible-2d-mapping f g) (t w h))
|
||||
(define x-min +inf.0)
|
||||
(define x-max -inf.0)
|
||||
(define y-min +inf.0)
|
||||
(define y-max -inf.0)
|
||||
(let: y-loop : Void ([y : Fixnum 0])
|
||||
(when (y . fx< . h)
|
||||
(let: x-loop : Void ([x : Fixnum 0])
|
||||
(cond [(x . fx< . w)
|
||||
(define i (coords->index c w 0 x y))
|
||||
(define any-nonzero?
|
||||
(let: k-loop : Boolean ([k : Fixnum 0])
|
||||
(cond [(k . < . c) (cond [(= 0.0 (unsafe-flvector-ref vs (unsafe-fx+ i k)))
|
||||
(k-loop (unsafe-fx+ k 1))]
|
||||
[else #t])]
|
||||
[else #f])))
|
||||
(when any-nonzero?
|
||||
(define-values (new-x new-y) (f (+ 0.5 (fx->fl x)) (+ 0.5 (fx->fl y))))
|
||||
[(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)
|
||||
bounded-by)]))
|
||||
|
||||
(define-type Flomap-Transform (Integer Integer -> flomap-2d-mapping))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Transformations
|
||||
|
||||
(: flomap-transform-bounds (Flomap-Transform Integer Integer
|
||||
-> (values Integer Integer Integer Integer)))
|
||||
(define (flomap-transform-bounds t w h)
|
||||
(match-define (flomap-2d-mapping fun _ bounded-by) (t w h))
|
||||
|
||||
(: maybe-expand (Integer Integer Float Float Float Float -> (values Float Float Float Float)))
|
||||
(define (maybe-expand x y x-min y-min x-max y-max)
|
||||
;; transform the coordinate, possibly update the mins and maxes
|
||||
(define-values (new-x new-y) (fun (->fl x) (->fl y)))
|
||||
(values (if (new-x . < . x-min) new-x x-min)
|
||||
(if (new-y . < . y-min) new-y y-min)
|
||||
(if (new-x . > . x-max) new-x x-max)
|
||||
(if (new-y . > . y-max) new-y y-max)))
|
||||
|
||||
(define-values (x-min y-min x-max y-max)
|
||||
(case bounded-by
|
||||
[(id) (values 0 0 w h)]
|
||||
[(corners)
|
||||
(for*/fold: ([x-min : Float +inf.0]
|
||||
[y-min : Float +inf.0]
|
||||
[x-max : Float -inf.0]
|
||||
[y-max : Float -inf.0]
|
||||
) ([y : Integer (list 0 h)]
|
||||
[x : Integer (list 0 w)])
|
||||
(maybe-expand x y x-min y-min x-max y-max))]
|
||||
[(edges)
|
||||
(define-values (x-min1 y-min1 x-max1 y-max1)
|
||||
(for*/fold: ([x-min : Float +inf.0]
|
||||
[y-min : Float +inf.0]
|
||||
[x-max : Float -inf.0]
|
||||
[y-max : Float -inf.0]
|
||||
) ([y : Integer (in-range (fx+ h 1))]
|
||||
[x : Integer (list 0 w)])
|
||||
(maybe-expand x y x-min y-min x-max y-max)))
|
||||
(define-values (x-min2 y-min2 x-max2 y-max2)
|
||||
(for*/fold: ([x-min : Float +inf.0]
|
||||
[y-min : Float +inf.0]
|
||||
[x-max : Float -inf.0]
|
||||
[y-max : Float -inf.0]
|
||||
) ([y : Integer (list 0 h)]
|
||||
[x : Integer (in-range (fx+ w 1))])
|
||||
(maybe-expand x y x-min y-min x-max y-max)))
|
||||
(values (min x-min1 x-min2) (min y-min1 y-min2)
|
||||
(max x-max1 x-max2) (max y-max1 y-max2))]
|
||||
[(all)
|
||||
;; these will be mutated within the loop (instead of accumulating them, which is annoying)
|
||||
(define-values (x-min y-min x-max y-max) (values +inf.0 +inf.0 -inf.0 -inf.0))
|
||||
;; for each point...
|
||||
(let: y-loop : Void ([y : Nonnegative-Fixnum 0])
|
||||
(when (y . fx<= . h)
|
||||
(let: x-loop : Void ([x : Nonnegative-Fixnum 0])
|
||||
(cond [(x . fx<= . w)
|
||||
;; transform the coordinate, possibly set the mins and maxes
|
||||
(define-values (new-x new-y) (fun (->fl x) (->fl y)))
|
||||
(when (new-x . < . x-min) (set! x-min new-x))
|
||||
(when (new-x . > . x-max) (set! x-max new-x))
|
||||
(when (new-y . < . y-min) (set! y-min new-y))
|
||||
(when (new-y . > . y-max) (set! y-max new-y)))
|
||||
(x-loop (unsafe-fx+ x 1))]
|
||||
[else
|
||||
(y-loop (unsafe-fx+ y 1))]))))
|
||||
(flomap-transform fm t x-min y-min x-max y-max)]
|
||||
[(fm t x-min y-min x-max y-max)
|
||||
(let ([x-min (exact->inexact x-min)]
|
||||
[y-min (exact->inexact y-min)]
|
||||
[x-max (exact->inexact x-max)]
|
||||
[y-max (exact->inexact y-max)])
|
||||
(match-define (flomap vs c w h) fm)
|
||||
(match-define (invertible-2d-mapping f g) (t w h))
|
||||
(define int-x-min (fl->fx (floor x-min)))
|
||||
(define int-y-min (fl->fx (floor y-min)))
|
||||
(define int-x-max (fl->fx (ceiling x-max)))
|
||||
(define int-y-max (fl->fx (ceiling y-max)))
|
||||
(define new-w (- int-x-max int-x-min))
|
||||
(define new-h (- int-y-max int-y-min))
|
||||
(define x-offset (+ 0.5 (fx->fl int-x-min)))
|
||||
(define y-offset (+ 0.5 (fx->fl int-y-min)))
|
||||
(inline-build-flomap*
|
||||
c new-w new-h
|
||||
(λ (x y _i)
|
||||
(define-values (old-x old-y) (g (+ (fx->fl x) x-offset)
|
||||
(+ (fx->fl y) y-offset)))
|
||||
(flomap-bilinear-ref* fm old-x old-y))))]))
|
||||
(when (new-y . > . y-max) (set! y-max new-y))
|
||||
(x-loop (unsafe-fx+ x 1))]
|
||||
[else
|
||||
(y-loop (unsafe-fx+ y 1))]))))
|
||||
(values x-min y-min x-max y-max)]))
|
||||
;; return integer bounds
|
||||
(cond [(and (rational? x-min) (rational? y-min) (rational? x-max) (rational? y-max))
|
||||
(values (round (inexact->exact x-min))
|
||||
(round (inexact->exact y-min))
|
||||
(round (inexact->exact x-max))
|
||||
(round (inexact->exact y-max)))]
|
||||
[else (values 0 0 0 0)]))
|
||||
|
||||
(: rotate-transform (Real -> Flomap-Transform))
|
||||
(define ((rotate-transform θ) w h)
|
||||
(: flomap-transform-compose (Flomap-Transform Flomap-Transform -> Flomap-Transform))
|
||||
(define ((flomap-transform-compose t2 t1) w0 h0)
|
||||
(match-define (flomap-2d-mapping fun1 inv1 bounded-by1) (t1 w0 h0))
|
||||
(define-values (x-start y-start x-end y-end) (flomap-transform-bounds t1 w0 h0))
|
||||
(define w1 (- x-end x-start))
|
||||
(define h1 (- y-end y-start))
|
||||
(match-define (flomap-2d-mapping fun2 inv2 bounded-by2) (t2 w1 h1))
|
||||
(flomap-2d-mapping
|
||||
(λ (x y)
|
||||
(let-values ([(x y) (fun1 x y)])
|
||||
(fun2 (- x x-start) (- y y-start))))
|
||||
(λ (x y)
|
||||
(let-values ([(x y) (inv2 x y)])
|
||||
(inv1 (+ x x-start) (+ y y-start))))
|
||||
(cond [(or (symbol=? bounded-by1 'all) (symbol=? bounded-by2 'all)) 'all]
|
||||
[(or (symbol=? bounded-by1 'edges) (symbol=? bounded-by2 'edges)) 'edges]
|
||||
[(or (symbol=? bounded-by1 'corners) (symbol=? bounded-by2 'corners)) 'corners]
|
||||
[(or (symbol=? bounded-by1 'id) (symbol=? bounded-by2 'id)) 'id])))
|
||||
|
||||
(: flomap-transform (case-> (flomap Flomap-Transform -> flomap)
|
||||
(flomap Flomap-Transform Integer Integer Integer Integer -> flomap)))
|
||||
(define flomap-transform
|
||||
(case-lambda
|
||||
[(fm t) (match-define (flomap _vs _c w h) fm)
|
||||
(define-values (x-start y-start x-end y-end)
|
||||
(flomap-transform-bounds t w h))
|
||||
(flomap-transform fm t x-start y-start x-end y-end)]
|
||||
[(fm t x-start y-start x-end y-end)
|
||||
(match-define (flomap _ c w h) fm)
|
||||
(match-define (flomap-2d-mapping _ inv _) (t w h)) ; only need the inverse mapping
|
||||
(define new-w (- x-end x-start))
|
||||
(define new-h (- y-end y-start))
|
||||
(define x-offset (+ 0.5 x-start))
|
||||
(define y-offset (+ 0.5 y-start))
|
||||
(inline-build-flomap*
|
||||
c new-w new-h
|
||||
(λ (x y _i)
|
||||
(define-values (old-x old-y) (inv (+ (fx->fl x) x-offset)
|
||||
(+ (fx->fl y) y-offset)))
|
||||
(flomap-bilinear-ref* fm old-x old-y)))]))
|
||||
|
||||
(: flomap-id-transform Flomap-Transform)
|
||||
(define (flomap-id-transform w h)
|
||||
(flomap-2d-mapping (λ (x y) (values x y)) (λ (x y) (values x y)) 'id))
|
||||
|
||||
(: flomap-scale-transform (case-> (Real -> Flomap-Transform)
|
||||
(Real Real -> Flomap-Transform)))
|
||||
(define flomap-scale-transform
|
||||
(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)])
|
||||
(λ (w h)
|
||||
(flomap-2d-mapping (λ (x y) (values (* x x-scale) (* y y-scale)))
|
||||
(λ (x y) (values (/ x x-scale) (/ y y-scale)))
|
||||
'corners)))]))
|
||||
|
||||
(: flomap-rotate-transform (Real -> Flomap-Transform))
|
||||
(define ((flomap-rotate-transform θ) w h)
|
||||
(let ([θ (- (exact->inexact θ))])
|
||||
(define cos-θ (cos θ))
|
||||
(define sin-θ (sin θ))
|
||||
(define x-mid (* 0.5 (->fl w)))
|
||||
(define y-mid (* 0.5 (->fl h)))
|
||||
(invertible-2d-mapping
|
||||
(λ: ([x : Flonum] [y : Flonum])
|
||||
(flomap-2d-mapping
|
||||
(λ: ([x : Float] [y : Float])
|
||||
(let ([x (- x x-mid)]
|
||||
[y (- y y-mid)])
|
||||
(values (+ x-mid (- (* x cos-θ) (* y sin-θ)))
|
||||
(+ y-mid (+ (* x sin-θ) (* y cos-θ))))))
|
||||
(λ: ([x : Flonum] [y : Flonum])
|
||||
(λ: ([x : Float] [y : Float])
|
||||
(let ([x (- x x-mid)]
|
||||
[y (- y y-mid)])
|
||||
(values (+ x-mid (+ (* x cos-θ) (* y sin-θ)))
|
||||
(+ y-mid (- (* y cos-θ) (* x sin-θ)))))))))
|
||||
(+ y-mid (- (* y cos-θ) (* x sin-θ))))))
|
||||
'corners)))
|
||||
|
||||
(: whirl-and-pinch-function (Real Real Real Integer Integer
|
||||
-> (Flonum Flonum -> (values Flonum Flonum))))
|
||||
(define (whirl-and-pinch-function θ pinch radius w h)
|
||||
(let ([θ (exact->inexact θ)]
|
||||
[pinch (- (exact->inexact pinch))]
|
||||
[radius (exact->inexact radius)])
|
||||
(define pinch-exp
|
||||
(cond [(pinch . >= . 0.0) pinch]
|
||||
[else (/ pinch (- 1.0 pinch))]))
|
||||
(: whirl-function (Real Integer Integer -> (Float Float -> (values Float Float))))
|
||||
(define (whirl-function θ w h)
|
||||
(let ([θ (exact->inexact θ)])
|
||||
(define x-mid (* 0.5 (->fl w)))
|
||||
(define y-mid (* 0.5 (->fl h)))
|
||||
(define-values (x-scale y-scale)
|
||||
|
|
@ -153,31 +247,100 @@
|
|||
[(x-mid . > . y-mid) (values 1.0 (/ x-mid y-mid))]
|
||||
[else (values 1.0 1.0)]))
|
||||
(define fm-radius (* 0.5 (->fl (max w h))))
|
||||
(define fm-radius^2 (* radius (sqr fm-radius)))
|
||||
(define x-max (+ 0.5 (->fl w)))
|
||||
(define y-max (+ 0.5 (->fl h)))
|
||||
(λ: ([x : Flonum] [y : Flonum])
|
||||
(define fm-radius^2 (sqr fm-radius))
|
||||
(define x-max (->fl w))
|
||||
(define y-max (->fl h))
|
||||
(λ: ([x : Float] [y : Float])
|
||||
(define dx (* (- x x-mid) x-scale))
|
||||
(define dy (* (- y y-mid) y-scale))
|
||||
(define r^2 (+ (sqr dx) (sqr dy)))
|
||||
(cond [(r^2 . < . fm-radius^2)
|
||||
(define r (flsqrt (/ r^2 fm-radius^2)))
|
||||
(define factor (cond [(or (r . = . 0.0) (pinch . = . 0.0)) 1.0]
|
||||
[else (flexpt r pinch-exp)]))
|
||||
(define pinched-dx (* dx factor))
|
||||
(define pinched-dy (* dy factor))
|
||||
(define ang (* θ (sqr (- 1.0 r))))
|
||||
(define cos-a (cos ang))
|
||||
(define sin-a (sin ang))
|
||||
(define old-x (+ (/ (- (* pinched-dx cos-a) (* pinched-dy sin-a)) x-scale) x-mid))
|
||||
(define old-y (+ (/ (+ (* pinched-dx sin-a) (* pinched-dy cos-a)) y-scale) y-mid))
|
||||
(values (max -0.5 (min x-max old-x))
|
||||
(max -0.5 (min y-max old-y)))]
|
||||
(define old-x (+ (/ (- (* dx cos-a) (* dy sin-a)) x-scale) x-mid))
|
||||
(define old-y (+ (/ (+ (* dx sin-a) (* dy cos-a)) y-scale) y-mid))
|
||||
(values (max 0.0 (min x-max old-x))
|
||||
(max 0.0 (min y-max old-y)))]
|
||||
[else
|
||||
(values x y)]))))
|
||||
|
||||
(: whirl-and-pinch-transform (Real Real Real -> Flomap-Transform))
|
||||
(define ((whirl-and-pinch-transform θ pinch radius) w h)
|
||||
(invertible-2d-mapping
|
||||
(whirl-and-pinch-function (- θ) (- pinch) radius w h)
|
||||
(whirl-and-pinch-function θ pinch radius w h)))
|
||||
(: flomap-whirl-transform (Real -> Flomap-Transform))
|
||||
(define ((flomap-whirl-transform θ) w h)
|
||||
(flomap-2d-mapping (whirl-function (- θ) w h) (whirl-function θ w h) 'id))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Projection transforms
|
||||
|
||||
(struct: projection-mapping ([fun : (Float -> Float)]
|
||||
[inv : (Float -> Float)]))
|
||||
|
||||
(define-type Projection (Float -> projection-mapping))
|
||||
|
||||
(: perspective-projection (Real -> Projection))
|
||||
(define ((perspective-projection α) d)
|
||||
(define f (/ d 2.0 (tan (* 0.5 (exact->inexact α)))))
|
||||
(projection-mapping (λ (ρ) (* (tan ρ) f))
|
||||
(λ (r) (atan (/ r f)))))
|
||||
|
||||
(: linear-projection (Real -> Projection))
|
||||
(define ((linear-projection α) d)
|
||||
(define f (/ d (exact->inexact α)))
|
||||
(projection-mapping (λ (ρ) (* ρ f))
|
||||
(λ (r) (/ r f))))
|
||||
|
||||
(: orthographic-projection (Real -> Projection))
|
||||
(define ((orthographic-projection α) d)
|
||||
(define f (/ d 2.0 (sin (* 0.5 (exact->inexact α)))))
|
||||
(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 α)))))
|
||||
(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 α)))))
|
||||
(projection-mapping (λ (ρ) (* 2.0 (tan (* 0.5 ρ)) f))
|
||||
(λ (r) (* 2.0 (atan (/ r 2.0 f))))))
|
||||
|
||||
(: reproject (Projection Projection Boolean Integer Integer -> (Float Float -> (values Float Float))))
|
||||
(define (reproject to-proj from-proj crop? w h)
|
||||
(define x-max (->fl w))
|
||||
(define y-max (->fl h))
|
||||
(define x-mid (* 0.5 x-max))
|
||||
(define y-mid (* 0.5 y-max))
|
||||
(define d (* 2.0 (flsqrt (+ (sqr x-mid) (sqr y-mid)))))
|
||||
(match-define (projection-mapping _ inv) (from-proj d))
|
||||
(match-define (projection-mapping fun _) (to-proj d))
|
||||
(λ: ([x : Float] [y : Float])
|
||||
(define dx (- x x-mid))
|
||||
(define dy (- y y-mid))
|
||||
(define θ (atan dy dx))
|
||||
(define r (flsqrt (+ (sqr dx) (sqr dy))))
|
||||
(define new-r (fun (inv r)))
|
||||
(define new-x (+ x-mid (* (cos θ) new-r)))
|
||||
(define new-y (+ y-mid (* (sin θ) new-r)))
|
||||
(cond [crop? (values (if (or (new-x . < . 0.0) (new-x . > . x-max)) +nan.0 new-x)
|
||||
(if (or (new-y . < . 0.0) (new-y . > . y-max)) +nan.0 new-y))]
|
||||
[else (values new-x new-y)])))
|
||||
|
||||
(: flomap-projection-transform (case-> (Projection Projection -> Flomap-Transform)
|
||||
(Projection Projection Boolean -> Flomap-Transform)))
|
||||
(define flomap-projection-transform
|
||||
(case-lambda
|
||||
[(to-proj from-proj) (flomap-projection-transform to-proj from-proj #t)]
|
||||
[(to-proj from-proj crop?)
|
||||
(λ (w h) (flomap-2d-mapping (reproject to-proj from-proj crop? w h)
|
||||
(reproject from-proj to-proj crop? w h)
|
||||
'edges))]))
|
||||
|
||||
(: flomap-fisheye-transform (Real -> Flomap-Transform))
|
||||
(define (flomap-fisheye-transform α)
|
||||
(flomap-projection-transform (equal-area-projection α)
|
||||
(perspective-projection α)
|
||||
#f))
|
||||
|
|
|
|||
|
|
@ -22,11 +22,11 @@
|
|||
|
||||
;; This looks stupid, but it avoids an optimization TR does that is actually a pessimization, by
|
||||
;; keeping it from recognizing flvector-ref
|
||||
(: flvector-ref (FlVector Integer -> Flonum))
|
||||
(: flvector-ref (FlVector Integer -> Float))
|
||||
(define flvector-ref old:flvector-ref)
|
||||
|
||||
;; Ditto above
|
||||
(: flvector-set! (FlVector Integer Flonum -> Void))
|
||||
(: flvector-set! (FlVector Integer Float -> Void))
|
||||
(define flvector-set! old:flvector-set!)
|
||||
|
||||
(define-syntax-rule (inline-build-flvector size f)
|
||||
|
|
@ -38,11 +38,11 @@
|
|||
(loop (unsafe-fx+ i 1))]
|
||||
[else vs])))))
|
||||
|
||||
(: flvector->vector (FlVector -> (Vectorof Flonum)))
|
||||
(: flvector->vector (FlVector -> (Vectorof Float)))
|
||||
(define (flvector->vector vs)
|
||||
(define n (flvector-length vs))
|
||||
(define new-vs (make-vector n 0.0))
|
||||
(let: loop : (Vectorof Flonum) ([k : Nonnegative-Fixnum 0])
|
||||
(let: loop : (Vectorof Float) ([k : Nonnegative-Fixnum 0])
|
||||
(cond [(k . < . n) (unsafe-vector-set! new-vs k (unsafe-flvector-ref vs k))
|
||||
(loop (unsafe-fx+ k 1))]
|
||||
[else new-vs])))
|
||||
|
|
@ -63,80 +63,80 @@
|
|||
(cond [(flvector? vs) vs]
|
||||
[else (real-vector->flvector vs)]))
|
||||
|
||||
(: fx->fl (Fixnum -> Flonum))
|
||||
(: fx->fl (Fixnum -> Float))
|
||||
(define fx->fl ->fl)
|
||||
|
||||
(: fl->fx (Flonum -> Fixnum))
|
||||
(: fl->fx (Float -> Fixnum))
|
||||
(define (fl->fx x)
|
||||
(define i (fl->exact-integer x))
|
||||
(with-asserts ([i fixnum?]) i))
|
||||
|
||||
(: flrational? (Flonum -> Boolean))
|
||||
(: flrational? (Float -> Boolean))
|
||||
(define (flrational? x)
|
||||
;; if x = +nan.0, both tests return #f
|
||||
(and (x . > . -inf.0) (x . < . +inf.0)))
|
||||
|
||||
(: fl-convex-combination (Flonum Flonum Flonum -> Flonum))
|
||||
(: fl-convex-combination (Float Float Float -> Float))
|
||||
(define (fl-convex-combination dv sv sa)
|
||||
(+ (* sv sa) (* dv (- 1.0 sa))))
|
||||
|
||||
(: fl-alpha-blend (Flonum Flonum Flonum -> Flonum))
|
||||
(: fl-alpha-blend (Float Float Float -> Float))
|
||||
(define (fl-alpha-blend dca sca sa)
|
||||
(+ sca (* dca (- 1.0 sa))))
|
||||
|
||||
(: flgaussian (Flonum Flonum -> Flonum))
|
||||
(: flgaussian (Float Float -> Float))
|
||||
(define (flgaussian x s)
|
||||
(define x/s (/ x s))
|
||||
(/ (exp (* -0.5 (* x/s x/s)))
|
||||
(* (sqrt (* 2.0 pi)) s)))
|
||||
|
||||
(: flsigmoid (Flonum -> Flonum))
|
||||
(: flsigmoid (Float -> Float))
|
||||
(define (flsigmoid x)
|
||||
(/ 1.0 (+ 1.0 (exp (- x)))))
|
||||
|
||||
;; =================================================================================================
|
||||
;; 3-vectors
|
||||
|
||||
(: fl3dot (Flonum Flonum Flonum Flonum Flonum Flonum -> Flonum))
|
||||
(: fl3dot (Float Float Float Float Float Float -> Float))
|
||||
(define (fl3dot x1 y1 z1 x2 y2 z2)
|
||||
(+ (* x1 x2) (* y1 y2) (* z1 z2)))
|
||||
|
||||
(: fl3* (case-> (Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum))
|
||||
(Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum))))
|
||||
(: fl3* (case-> (Float Float Float Float -> (values Float Float Float))
|
||||
(Float Float Float Float Float Float -> (values Float Float Float))))
|
||||
(define fl3*
|
||||
(case-lambda
|
||||
[(x y z c) (values (* x c) (* y c) (* z c))]
|
||||
[(x1 y1 z1 x2 y2 z2) (values (* x1 x2) (* y1 y2) (* z1 z2))]))
|
||||
|
||||
(: fl3+ (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum)))
|
||||
(: fl3+ (Float Float Float Float Float Float -> (values Float Float Float)))
|
||||
(define (fl3+ x1 y1 z1 x2 y2 z2)
|
||||
(values (+ x1 x2) (+ y1 y2) (+ z1 z2)))
|
||||
|
||||
(: fl3- (case-> (Flonum Flonum Flonum -> (values Flonum Flonum Flonum))
|
||||
(Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum))))
|
||||
(: fl3- (case-> (Float Float Float -> (values Float Float Float))
|
||||
(Float Float Float Float Float Float -> (values Float Float Float))))
|
||||
(define fl3-
|
||||
(case-lambda
|
||||
[(x y z) (values (- x) (- y) (- z))]
|
||||
[(x1 y1 z1 x2 y2 z2) (values (- x1 x2) (- y1 y2) (- z1 z2))]))
|
||||
|
||||
(: fl3mag^2 (Flonum Flonum Flonum -> Flonum))
|
||||
(: fl3mag^2 (Float Float Float -> Float))
|
||||
(define (fl3mag^2 x y z)
|
||||
(+ (* x x) (* y y) (* z z)))
|
||||
|
||||
(: fl3mag (Flonum Flonum Flonum -> Flonum))
|
||||
(: fl3mag (Float Float Float -> Float))
|
||||
(define (fl3mag x y z)
|
||||
(flsqrt (fl3mag^2 x y z)))
|
||||
|
||||
(: fl3dist (Flonum Flonum Flonum Flonum Flonum Flonum -> Flonum))
|
||||
(: fl3dist (Float Float Float Float Float Float -> Float))
|
||||
(define (fl3dist x1 y1 z1 x2 y2 z2)
|
||||
(fl3mag (- x1 x2) (- y1 y2) (- z1 z2)))
|
||||
|
||||
(: fl3normalize (Flonum Flonum Flonum -> (values Flonum Flonum Flonum)))
|
||||
(: fl3normalize (Float Float Float -> (values Float Float Float)))
|
||||
(define (fl3normalize x y z)
|
||||
(define d (fl3mag x y z))
|
||||
(values (/ x d) (/ y d) (/ z d)))
|
||||
|
||||
(: fl3-half-norm (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum)))
|
||||
(: fl3-half-norm (Float Float Float Float Float Float -> (values Float Float Float)))
|
||||
(define (fl3-half-norm x1 y1 z1 x2 y2 z2)
|
||||
(fl3normalize (+ x1 x2) (+ y1 y2) (+ z1 z2)))
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
@defmodule[images/flomap]
|
||||
|
||||
The @racketmodname[images/flomap] module provides the struct type @racket[flomap], whose instances represent floating-point bitmaps with any number of color components.
|
||||
It also provides purely functional operations on flomaps for compositing, pointwise floating-point math, blur, gradient calculation, arbitrary spatial transformations (such as rotation), and conversion to and from @racket[bitmap%] instances.
|
||||
It also provides purely functional operations on flomaps for compositing, pointwise floating-point math, blur, gradient calculation, arbitrary spatial transforms (such as rotation), and conversion to and from @racket[bitmap%] instances.
|
||||
|
||||
@bold{This is a Typed Racket module.}
|
||||
Its exports can generally be used from untyped code with negligible performance loss over typed code.
|
||||
|
|
@ -60,6 +60,9 @@ Contents:
|
|||
|
||||
@section{Overview}
|
||||
|
||||
Contents:
|
||||
@local-table-of-contents[]
|
||||
|
||||
@subsection{Motivation}
|
||||
|
||||
There are three main reasons to use flomaps:
|
||||
|
|
@ -100,8 +103,8 @@ Note that @racket[flomap-ref] accepts its coordinate arguments in a standard ord
|
|||
(flomap-ref* magenta-fm 0 1000)
|
||||
(flomap-ref magenta-fm 3 0 0)]
|
||||
|
||||
Many flomap functions, such as @racket[flomap-bilinear-ref], treat their arguments as if every @italic{real} @racket[x] @racket[y] coordinate has values.
|
||||
In all such cases, known nonzero values are at half-integer coordinates and others are interpolated.
|
||||
Many flomap functions, such as @racket[flomap-bilinear-ref] and @racket[flomap-rotate], treat their arguments as if every @italic{real} @racket[x] @racket[y] coordinate has values.
|
||||
In all such cases, known values are at half-integer coordinates and others are interpolated.
|
||||
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap-bilinear-ref* magenta-fm 0.5 0.5)
|
||||
|
|
@ -123,6 +126,9 @@ Notice that the plot's maximum height is above saturation (@racket[1.0]).
|
|||
The tallest peak corresponds to the specular highlight (the shiny part) on the bomb.
|
||||
Specular highlights are one case where it is important to operate on oversaturated values without truncating them---until it is time to display the image.
|
||||
|
||||
If we have a @racket[w]×@racket[h] flomap and consider its known values as being at half-integer coordinates, the exact center of the flomap is at @racket[(* 1/2 w)] @racket[(* 1/2 h)].
|
||||
When unknown values are estimated using bilinear interpolation, the finite rectangle containing all the known @italic{and estimated} nonzero values is from @racket[-1/2] @racket[-1/2] to @racket[(+ w 1/2)] @racket[(+ h 1/2)].
|
||||
|
||||
@subsection[#:tag "flomap:opacity"]{Opacity (Alpha Components)}
|
||||
|
||||
A partially transparent flomap is simply a flomap in which component @racket[0] is assumed to be an alpha (opacity) component.
|
||||
|
|
@ -885,82 +891,411 @@ See @racket[flomap-pin] and @racket[flomap-pin*] for implementation details.
|
|||
@; ===================================================================================================
|
||||
|
||||
|
||||
@section{Transformations}
|
||||
@section{Spatial Transformations}
|
||||
|
||||
This section gives the API for applying spatial transforms to a flomap, such as rotations, warps, morphs, and lens distortion effects.
|
||||
|
||||
To use the provided transforms, apply a function like @racket[flomap-flip-horizontal] directly,
|
||||
or apply something like a @racket[flomap-rotate-transform] to a flomap using @racket[flomap-transform].
|
||||
|
||||
To make your own transforms, compose existing ones with @racket[flomap-transform-compose], or construct a value of type @racket[Flomap-Transform] directly:
|
||||
@racketblock[(: my-awesome-transform Flomap-Transform)
|
||||
(define (my-awesome-transform w h)
|
||||
(make-flomap-2d-mapping fun inv))]
|
||||
Here, @racket[fun] is a mapping from input coordinates to output coordinates and @racket[inv] is its inverse.
|
||||
|
||||
Contents:
|
||||
@local-table-of-contents[]
|
||||
|
||||
@subsection{Provided Transformations}
|
||||
|
||||
@defproc[(flomap-flip-horizontal [fm flomap]) flomap]
|
||||
@defproc[(flomap-flip-vertical [fm flomap]) flomap]
|
||||
@defproc[(flomap-transpose [fm flomap]) flomap]
|
||||
@defproc[(flomap-cw-rotate [fm flomap]) flomap]
|
||||
@defproc[(flomap-ccw-rotate [fm flomap]) flomap]{
|
||||
Some standard image transformations.
|
||||
These are lossless, in that repeated transformations do not degrade the image.
|
||||
Some standard image transforms.
|
||||
These are lossless, in that repeated applications do not degrade (blur or alias) the image.
|
||||
@examples[#:eval flomap-eval
|
||||
(require slideshow/pict)
|
||||
(define hello-fm (flomap-trim
|
||||
(bitmap->flomap
|
||||
(pict->bitmap (text "Hello" '(bold) 25)))))
|
||||
(flomap->bitmap hello-fm)
|
||||
(flomap->bitmap (flomap-flip-horizontal hello-fm))
|
||||
(flomap->bitmap (flomap-flip-vertical hello-fm))
|
||||
(flomap->bitmap (flomap-transpose hello-fm))
|
||||
(flomap->bitmap (flomap-cw-rotate hello-fm))
|
||||
(flomap->bitmap (flomap-ccw-rotate hello-fm))]
|
||||
(define text-fm
|
||||
(flomap-trim
|
||||
(bitmap->flomap
|
||||
(pict->bitmap (vc-append (text "We CLAIM the" '(bold) 25)
|
||||
(text "PRIVILEGE" '(bold) 25))))))
|
||||
(flomap->bitmap text-fm)
|
||||
(flomap->bitmap (flomap-flip-horizontal text-fm))
|
||||
(flomap->bitmap (flomap-flip-vertical text-fm))
|
||||
(flomap->bitmap (flomap-transpose text-fm))
|
||||
(flomap->bitmap (flomap-cw-rotate text-fm))
|
||||
(flomap->bitmap (flomap-ccw-rotate text-fm))
|
||||
(equal? (flomap-cw-rotate fm)
|
||||
(flomap-flip-vertical (flomap-transpose fm)))
|
||||
(equal? (flomap-ccw-rotate fm)
|
||||
(flomap-flip-horizontal (flomap-transpose fm)))]
|
||||
}
|
||||
|
||||
@defproc[(flomap-rotate [fm flomap] [θ Real]) flomap]{
|
||||
Equivalent to @racket[(flomap-transform fm (rotate-transform θ))].
|
||||
Returns a flomap rotated by @racket[θ] radians counterclockwise.
|
||||
Equivalent to @racket[(flomap-transform fm (flomap-rotate-transform θ))].
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap->bitmap (flomap-rotate hello-fm (* 1/4 pi)))]
|
||||
(flomap->bitmap (flomap-rotate text-fm (* 1/4 pi)))]
|
||||
}
|
||||
|
||||
@defstruct*[invertible-2d-mapping ([fun (Float Float -> (values Float Float))]
|
||||
[inv (Float Float -> (values Float Float))])]{
|
||||
@defproc[(flomap-rotate-transform [θ Real]) Flomap-Transform]{
|
||||
Returns a flomap transform that rotates a flomap @racket[θ] radians counterclockwise around its (@racket[Real]-valued) center.
|
||||
|
||||
Use @racket[flomap-rotate-transform] if you need to know the bounds of the rotated flomap or need to compose a rotation with another transform using @racket[flomap-transform-compose].
|
||||
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap-transform-bounds (flomap-rotate-transform (* 1/4 pi))
|
||||
100 100)
|
||||
(flomap->bitmap
|
||||
(flomap-transform text-fm (flomap-rotate-transform (* 1/4 pi))))]
|
||||
}
|
||||
|
||||
@defidform[Flomap-Transform]{
|
||||
Defined as @racket[(Integer Integer -> invertible-2d-mapping)].
|
||||
@defproc[(flomap-whirl-transform [θ Real]) Flomap-Transform]{
|
||||
Returns a flomap transform that ``whirls'' a flomap: rotates it counterclockwise @racket[θ] radians in the center, and rotates less with more distance from the center.
|
||||
|
||||
This transform does not alter the size of its input.
|
||||
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-transform text-fm (flomap-whirl-transform pi)))]
|
||||
}
|
||||
|
||||
@defproc[(flomap-fisheye-transform [α Real]) Flomap-Transform]{
|
||||
Returns a flomap transform that simulates ``fisheye'' lens distortion with an @racket[α] diagonal angle of view.
|
||||
Equivalent to
|
||||
@racketblock[(flomap-projection-transform (equal-area-projection α)
|
||||
(perspective-projection α)
|
||||
#f)]
|
||||
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-transform text-fm (flomap-fisheye-transform (* 2/3 pi))))]
|
||||
}
|
||||
|
||||
@defproc[(flomap-scale-transform [x-scale Real] [y-scale Real x-scale]) Flomap-Transform]{
|
||||
Returns a flomap transform that scales flomaps by @racket[x-scale] horizontally and @racket[y-scale] vertically.
|
||||
|
||||
You should generally prefer to use @racket[flomap-scale], which is faster and correctly reduces resolution before downsampling to avoid aliasing.
|
||||
This is provided for composition with other transforms using @racket[flomap-transform-compose].
|
||||
}
|
||||
|
||||
@defthing[flomap-id-transform Flomap-Transform]{
|
||||
A flomap transform that does nothing.
|
||||
See @racket[flomap-transform-compose] for an example of using @racket[flomap-id-transform] as the initial value for a fold.
|
||||
}
|
||||
|
||||
@subsection{General Transformations}
|
||||
|
||||
@defproc*[([(flomap-transform [fm flomap] [t Flomap-Transform]) flomap]
|
||||
[(flomap-transform [fm flomap] [t Flomap-Transform]
|
||||
[x-min Real] [y-min Real]
|
||||
[x-max Real] [y-max Real])
|
||||
[x-start Integer] [y-start Integer]
|
||||
[x-end Integer] [y-end Integer])
|
||||
flomap])]{
|
||||
Applies spatial transform @racket[t] to @racket[fm].
|
||||
|
||||
The rectangle @racket[x-start] @racket[y-start] @racket[x-end] @racket[y-end] is with respect to the @racket[fm]'s @italic{transformed} coordinates.
|
||||
If given, points in @racket[fm] are transformed only if their transformed coordinates are within that rectangle.
|
||||
If not given, @racket[flomap-transform] uses the rectangle returned by @racket[(flomap-transform-bounds t w h)], where @racket[w] and @racket[h] are the size of @racket[fm].
|
||||
|
||||
This transform doubles a flomap's size:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define (double-transform w h)
|
||||
(make-flomap-2d-mapping (λ (x y) (values (* x 2) (* y 2)))
|
||||
(λ (x y) (values (/ x 2) (/ y 2)))))
|
||||
(flomap->bitmap
|
||||
(flomap-transform text-fm double-transform))]
|
||||
Transforms can use the width and height arguments @racket[w] @racket[h] however they wish; for example, @racket[double-transform] ignores them, and @racket[flomap-rotate-transform] uses them to calculate the center coordinate.
|
||||
|
||||
The @racket[flomap-rotate] function usually increases the size of a flomap to fit its corners in the result.
|
||||
To rotate in a way that does not change the size---i.e. to do an @italic{in-place} rotation---use @racket[0] @racket[0] @racket[w] @racket[h] as the transformed rectangle:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define (flomap-in-place-rotate fm θ)
|
||||
(define-values (w h) (flomap-size fm))
|
||||
(flomap-transform fm (flomap-rotate-transform θ) 0 0 w h))]
|
||||
Using it on @racket[text-fm] with a purple background:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define-values (text-fm-w text-fm-h) (flomap-size text-fm))
|
||||
(define purple-text-fm
|
||||
(flomap-lt-superimpose (make-flomap* text-fm-w text-fm-h #(1 1/2 0 1))
|
||||
text-fm))
|
||||
(flomap->bitmap purple-text-fm)
|
||||
(flomap->bitmap (flomap-in-place-rotate purple-text-fm (* 1/8 pi)))]
|
||||
See @racket[flomap-projection-transform] for another example of using @racket[flomap-transform]'s rectangle arguments, to manually crop a lens projection.
|
||||
|
||||
Alternatively, we could define a new transform-producing function @racket[flomap-in-place-rotate-transform]
|
||||
that never transforms points outside of the orginal flomap:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define ((flomap-in-place-rotate-transform θ) w h)
|
||||
(match-define (flomap-2d-mapping fun inv _)
|
||||
((flomap-rotate-transform θ) w h))
|
||||
(make-flomap-2d-mapping (λ (x y)
|
||||
(let-values ([(x y) (fun x y)])
|
||||
(values (if (<= 0 x w) x +nan.0)
|
||||
(if (<= 0 y h) y +nan.0))))
|
||||
inv))
|
||||
(flomap->bitmap
|
||||
(flomap-transform purple-text-fm
|
||||
(flomap-in-place-rotate-transform (* 1/8 pi))))]
|
||||
|
||||
To transform @racket[fm], @racket[flomap-transform] uses only the @racketid[inv] field of @racket[(t w h)].
|
||||
Every point @racket[new-x] @racket[new-y] in the transformed bounds is given the components returned by
|
||||
@racketblock[(let-values ([(old-x old-y) (inv new-x new-y)])
|
||||
(flomap-bilinear-ref* fm old-x old-y))]
|
||||
The forward mapping @racket[fun] is used by @racket[flomap-transform-bounds].
|
||||
}
|
||||
|
||||
@defproc[(rotate-transform [θ Real]) Flomap-Transform]{
|
||||
rotates around center; positive is screen-clockwise
|
||||
@defidform[Flomap-Transform]{
|
||||
Defined as @racket[(Integer Integer -> flomap-2d-mapping)].
|
||||
|
||||
A value of type @racket[Flomap-Transform] receives the width and height of a flomap to operate on, and returns a @racket[flomap-2d-mapping] on the coordinates of flomaps of that size.
|
||||
}
|
||||
|
||||
@defproc[(whirl-and-pinch-transform [θ Real] [pinch Real] [radius Real]) Flomap-Transform]{
|
||||
@defstruct*[flomap-2d-mapping ([fun (Float Float -> (values Float Float))]
|
||||
[inv (Float Float -> (values Float Float))]
|
||||
[bounded-by (U 'id 'corners 'edges 'all)])]{
|
||||
Represents an invertible mapping from @racket[Real]×@racket[Real] to @racket[Real]×@racket[Real], or from real-valued flomap coordinates to real-valued flomap coordinates.
|
||||
See @racket[flomap-transform] for examples.
|
||||
See @secref{flomap:conceptual} for the meaning of real-valued flomap coordinates.
|
||||
|
||||
The forward mapping @racket[fun] is used to determine the bounds of a transformed flomap.
|
||||
(See @racket[flomap-transform-bounds] for details.)
|
||||
The inverse mapping @racket[inv] is used to actually transform the flomap.
|
||||
(See @racket[flomap-transform] for details.)
|
||||
|
||||
The symbol @racket[bounded-by] tells @racket[flomap-transform-bounds] how to transform bounds.
|
||||
In order of efficiency:
|
||||
@(itemlist
|
||||
@item{@racket['id]: Do not transform bounds.
|
||||
Use this for in-place transforms such as @racket[flomap-whirl-transform].}
|
||||
@item{@racket['corners]: Return the smallest rectangle containing only the transformed corners.
|
||||
Use this for linear and affine transforms (such as @racket[flomap-rotate-transform] or a skew transform),
|
||||
transforms that do not produce extreme points, and others for which it can be proved (or at least empirically demonstrated)
|
||||
that the rectangle containing the transformed corners contains all the transformed points.}
|
||||
@item{@racket['edges]: Return the smallest rectangle containing only the transformed left, top, right, and bottom edges.
|
||||
Use this for transforms that are almost-everywhere continuous and invertible---which describes most interesting transforms.}
|
||||
@item{@racket['all]: Return the smallest rectangle containing all the transformed points.
|
||||
Use this for transforms that produce overlaps and other non-invertible results.}
|
||||
)
|
||||
|
||||
For good performance, define instances of @racket[flomap-2d-mapping] and functions that return them (e.g. instances of @racket[Flomap-Transform]), in Typed Racket.
|
||||
Defining them in untyped Racket makes every application of @racket[fun] and @racket[inv] contract-checked when used in typed code, such as the implementation of @racket[flomap-transform].
|
||||
(In the worst case, @racket[flomap-transform] applies @racket[fun] to every pair of coordinates in the input flomap.
|
||||
It always applies @racket[inv] to every pair of coordinates in the output flomap.)
|
||||
}
|
||||
|
||||
@defproc[(transform-compose [t2 Flomap-Transform] [t1 Flomap-Transform]) Flomap-Transform]{
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap-size hello-fm)
|
||||
(define hello-fm-blurry
|
||||
(for/fold ([hello-fm hello-fm]) ([_ (in-range 8)])
|
||||
(flomap-rotate hello-fm (* 1/4 pi))))
|
||||
(flomap->bitmap hello-fm-blurry)
|
||||
(flomap-size hello-fm-blurry)]
|
||||
@defproc[(make-flomap-2d-mapping [fun (Float Float -> (values Real Real))]
|
||||
[inv (Float Float -> (values Real Real))]
|
||||
[bounded-by (U 'id 'corners 'edges 'all) 'edges]) flomap-2d-mapping]{
|
||||
A more permissive, more convenient constructor for @racket[flomap-2d-mapping].
|
||||
}
|
||||
|
||||
@examples[#:eval flomap-eval
|
||||
(define t
|
||||
(for/fold ([t (rotate-transform (* 1/4 pi))]) ([_ (in-range 7)])
|
||||
(transform-compose t (rotate-transform (* 1/4 pi)))))
|
||||
(define hello-fm-sharp
|
||||
(flomap-transform hello-fm t))
|
||||
(flomap->bitmap hello-fm-sharp)
|
||||
(flomap-size hello-fm-sharp)
|
||||
(flomap-extreme-values
|
||||
(fmsqr (fm- hello-fm hello-fm-sharp)))]
|
||||
@defproc[(flomap-transform-compose [t2 Flomap-Transform] [t1 Flomap-Transform]) Flomap-Transform]{
|
||||
Composes two flomap transforms.
|
||||
Applying the result of @racket[(flomap-transform-compose t2 t1)] is the same as applying @racket[t1] and then @racket[t2], @bold{except}:
|
||||
@(itemlist
|
||||
@item{The points are transformed only once, meaning their component values are estimated only once, so the result is less degraded (blurry or aliased).}
|
||||
@item{The bounds are generally tighter.}
|
||||
)
|
||||
|
||||
The following example ``whirls'' @racket[text-fm] clockwise 360 degrees and back.
|
||||
This is first done by applying the two transforms separately, and secondly by applying a composition of them.
|
||||
@interaction[#:eval flomap-eval
|
||||
(let* ([text-fm (flomap-transform
|
||||
text-fm (flomap-whirl-transform (* 2 pi)))]
|
||||
[text-fm (flomap-transform
|
||||
text-fm (flomap-whirl-transform (* -2 pi)))])
|
||||
(flomap->bitmap text-fm))
|
||||
(flomap->bitmap
|
||||
(flomap-transform text-fm (flomap-transform-compose
|
||||
(flomap-whirl-transform (* -2 pi))
|
||||
(flomap-whirl-transform (* 2 pi)))))]
|
||||
Notice the heavy aliasing (a ``Moiré pattern'') in the first result is not in the second.
|
||||
|
||||
In the next example, notice that rotating multiple times blurs the result and pads it with transparent points, but that applying composed rotation transforms doesn't:
|
||||
@interaction[#:eval flomap-eval
|
||||
(let* ([text-fm (flomap-rotate text-fm (* 1/8 pi))]
|
||||
[text-fm (flomap-rotate text-fm (* 1/8 pi))]
|
||||
[text-fm (flomap-rotate text-fm (* 1/8 pi))]
|
||||
[text-fm (flomap-rotate text-fm (* 1/8 pi))])
|
||||
(flomap->bitmap text-fm))
|
||||
(define rotate-pi/2
|
||||
(for/fold ([t flomap-id-transform]) ([_ (in-range 4)])
|
||||
(flomap-transform-compose (flomap-rotate-transform (* 1/8 pi)) t)))
|
||||
(flomap->bitmap (flomap-transform text-fm rotate-pi/2))]
|
||||
|
||||
How the bounds for the composed transform are calculated depends on how they would have been calculated for @racket[t1] and @racket[t2].
|
||||
Suppose @racket[b1] is the bounds rule for @racket[(t1 w h)] and @racket[b2] is the bounds rule for @racket[(t2 w h)].
|
||||
Then the bounds rule @racket[b] for @racket[(flomap-transform-compose t2 t1)] is determined by the following rules, applied in order:
|
||||
@(itemlist
|
||||
@item{If either @racket[b1] = @racket['all] or @racket[b2] = @racket['all], then @racket[b] = @racket['all].}
|
||||
@item{If either @racket[b1] = @racket['edges] or @racket[b2] = @racket['edges], then @racket[b] = @racket['edges].}
|
||||
@item{If either @racket[b1] = @racket['corners] or @racket[b2] = @racket['corners], then @racket[b] = @racket['corners].}
|
||||
@item{Otherwise, @racket[b1] = @racket[b2] = @racket['id], so @racket[b] = @racket['id].}
|
||||
)
|
||||
See @racket[flomap-2d-mapping] for details on how @racket[b] affects bounds calculation.
|
||||
}
|
||||
|
||||
@defproc[(flomap-transform-bounds [t Flomap-Transform] [w Integer] [h Integer])
|
||||
(values Integer Integer Integer Integer)]{
|
||||
Returns the rectangle that would contain a @racket[w]×@racket[h] flomap after transform by @racket[t].
|
||||
|
||||
How the rectangle is determined depends on the @racket[bounded-by] field of @racket[(t w h)].
|
||||
See @racket[flomap-2d-mapping] for details.
|
||||
|
||||
See @racket[flomap-rotate-transform] and @racket[flomap-projection-transform] for examples.
|
||||
}
|
||||
|
||||
@subsection{Lens Projection and Correction}
|
||||
|
||||
The following API demonstrates a parameterized family of spatial transforms.
|
||||
It also provides a physically grounded generalization of the flomap transforms returned by @racket[flomap-fisheye-transform].
|
||||
|
||||
@interaction-eval[#:eval flomap-eval
|
||||
(begin (require racket/draw)
|
||||
(define state-of-the-union-fm
|
||||
(bitmap->flomap (read-bitmap (build-path (current-directory) "scribblings" "images" "state-of-the-union.jpg") 'jpeg))))]
|
||||
|
||||
@defproc[(flomap-projection-transform [to-proj Projection] [from-proj Projection] [crop? Boolean]) Flomap-Transform]{
|
||||
Returns a flomap transform that corrects for or simulates lens distortion.
|
||||
|
||||
To correct for lens distortion in a flomap:
|
||||
@(itemlist
|
||||
@item{Find a projection @racket[from-proj] that models the actual lens.}
|
||||
@item{Find a projection @racket[to-proj] that models the desired (but fictional) lens.}
|
||||
@item{Apply @racket[(flomap-projection-transform to-proj from-proj)] to the flomap.}
|
||||
)
|
||||
|
||||
@margin-note*{This photo is in the public domain.}
|
||||
In the following example, a photo of the State of the Union address was taken using an ``equal area'' (or ``equisolid angle'') fisheye lens with a 180-degree diagonal angle of view:
|
||||
@interaction[#:eval flomap-eval
|
||||
(flomap->bitmap state-of-the-union-fm)]
|
||||
We would like it to have been taken with a perfect ``rectilinear'' (or ``perspective projection'') lens with a 120-degree diagonal angle of view.
|
||||
Following the steps above, we apply a projection transform using @racket[(equal-area-projection pi)] for @racket[from-proj] and @racket[(perspective-projection (* 2/3 pi))] for @racket[to-proj]:
|
||||
@interaction[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-transform
|
||||
state-of-the-union-fm
|
||||
(flomap-projection-transform (perspective-projection (* 2/3 pi))
|
||||
(equal-area-projection pi))))]
|
||||
Notice that the straight geometry in the House chamber (especially the trim around the ceiling) is represented by straight edges in the corrected photo.
|
||||
|
||||
When @racket[crop?] is @racket[#t], the output flomap is no larger than the input flomap.
|
||||
When @racket[crop?] is @racket[#f], the output flomap is large enough to contain the entire transformed flomap.
|
||||
An uncropped result can be quite large, especially with angles of view at or near @racket[180] degrees (@racket[pi] radians).
|
||||
@interaction[#:eval flomap-eval
|
||||
(define rectangle-fm
|
||||
(draw-flomap (λ (fm-dc)
|
||||
(send fm-dc set-pen "black" 4 'dot)
|
||||
(send fm-dc set-brush "yellow" 'solid)
|
||||
(send fm-dc set-alpha 1/2)
|
||||
(send fm-dc draw-rectangle 0 0 32 32))
|
||||
32 32))
|
||||
(flomap->bitmap rectangle-fm)
|
||||
(flomap-transform-bounds
|
||||
(flomap-projection-transform (perspective-projection (* 1/2 pi))
|
||||
(equal-area-projection pi)
|
||||
#f)
|
||||
32 32)
|
||||
(flomap->bitmap
|
||||
(flomap-transform
|
||||
rectangle-fm
|
||||
(flomap-projection-transform (perspective-projection (* 1/2 pi))
|
||||
(orthographic-projection (* 7/8 pi))
|
||||
#f)))]
|
||||
To crop manually, apply @racket[flomap-transform] to explicit rectangle arguments:
|
||||
@interaction[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-transform
|
||||
rectangle-fm
|
||||
(flomap-projection-transform (perspective-projection (* 1/2 pi))
|
||||
(orthographic-projection (* 7/8 pi))
|
||||
#f)
|
||||
-10 -10 42 42))]
|
||||
}
|
||||
|
||||
@defproc[(perspective-projection [α Real]) Projection]
|
||||
@defproc[(linear-projection [α Real]) Projection]
|
||||
@defproc[(orthographic-projection [α Real]) Projection]
|
||||
@defproc[(equal-area-projection [α Real]) Projection]
|
||||
@defproc[(stereographic-projection [α Real]) Projection]{
|
||||
Given a diagonal angle of view @racket[α], these all return a projection modeling some kind of camera lens.
|
||||
See @link["http://en.wikipedia.org/wiki/Fisheye_lens"]{Fisheye Lens} for the defining formulas.
|
||||
}
|
||||
|
||||
@defidform[Projection]{
|
||||
Equivalent to @racket[(Float -> projection-mapping)].
|
||||
|
||||
A value of type @racket[Projection] receives the diagonal size of a flomap to operate on, and returns a @racket[projection-mapping] instance.
|
||||
The provided projections (such as @racket[perspective-projection]) use a closed-over diagonal angle of view @racketid[α] and the diagonal size to calculate the focal length.
|
||||
}
|
||||
|
||||
@defstruct*[projection-mapping ([fun (Float -> Float)]
|
||||
[inv (Float -> Float)])]{
|
||||
Represents an invertible function from a point's angle @racket[ρ] from the optical axis, to the distance @racket[r] to the center of a photo, in flomap coordinates.
|
||||
|
||||
For example, given a diagonal angle of view @racket[α] and the diagonal size @racket[d] of a flomap, the @racket[perspective-projection] function calculates the focal length @racket[f]:
|
||||
@racketblock[(define f (/ d 2.0 (tan (* 0.5 α))))]
|
||||
It then constructs the projection mapping as
|
||||
@racketblock[(projection-mapping (λ (ρ) (* (tan ρ) f))
|
||||
(λ (r) (atan (/ r f))))]
|
||||
See @link["http://en.wikipedia.org/wiki/Fisheye_lens"]{Fisheye Lens} for details.
|
||||
}
|
||||
|
||||
|
||||
@; ===================================================================================================
|
||||
|
||||
|
||||
@;@section{Effects}
|
||||
@section{Effects}
|
||||
|
||||
@defproc[(flomap-shadow [fm flomap] [σ Real] [color (Option (U (Vectorof Real) FlVector)) #f]) flomap]{
|
||||
Returns the alpha (zeroth) component of @racket[fm], blurred with standard deviation @racket[σ] and colorized by @racket[color].
|
||||
Assumes @racket[fm] and @racket[color] are alpha-multiplied; see @secref{flomap:opacity}.
|
||||
|
||||
If @racket[color] = @racket[#f], it is interpreted as @racket[(flvector 1.0 0.0 ...)], or opaque black.
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-shadow (flomap-inset text-fm 12) 4 #(1/2 1/8 0 1/4)))
|
||||
(flomap->bitmap
|
||||
(flomap-cc-superimpose
|
||||
(flomap-shadow (flomap-inset text-fm 12) 4 #(1/2 1/8 0 1/4))
|
||||
text-fm))]
|
||||
}
|
||||
|
||||
@defproc[(flomap-outline [fm flomap] [radius Real] [color (Option (U (Vectorof Real) FlVector)) #f]) flomap]{
|
||||
Returns a flomap that outlines @racket[fm] with a @racket[radius]-thick line when @racket[fm] is superimposed over it.
|
||||
Assumes @racket[fm] and @racket[color] are alpha-multiplied; see @secref{flomap:opacity}.
|
||||
|
||||
If @racket[color] = @racket[#f], it is interpreted as @racket[(flvector 1.0 0.0 ...)], or opaque black.
|
||||
@examples[#:eval flomap-eval
|
||||
(flomap->bitmap
|
||||
(flomap-outline (flomap-inset text-fm 2) 2 #(1 0 1 1)))
|
||||
(flomap->bitmap
|
||||
(flomap-cc-superimpose
|
||||
(flomap-outline (flomap-inset text-fm 2) 2 #(1 0 1 1))
|
||||
text-fm))]
|
||||
|
||||
The greatest alpha value in the returned outline is the greatest alpha value in @racket[fm].
|
||||
Because of this, @racket[flomap-outline] does fine with flomaps with fully opaque regions that are made semi-transparent:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define trans-text-fm (fm* 0.5 text-fm))
|
||||
(flomap->bitmap trans-text-fm)
|
||||
(flomap->bitmap
|
||||
(flomap-cc-superimpose
|
||||
(flomap-outline (flomap-inset trans-text-fm 2) 2 #(1 0 1 1))
|
||||
trans-text-fm))]
|
||||
However, it does not do so well with flomaps that are partly opaque and partly semi-transparent:
|
||||
@interaction[#:eval flomap-eval
|
||||
(define mixed-text-fm
|
||||
(flomap-vc-append text-fm (make-flomap 4 0 10) trans-text-fm))
|
||||
(flomap->bitmap
|
||||
(flomap-cc-superimpose
|
||||
(flomap-outline (flomap-inset mixed-text-fm 2) 2 #(1 0 1 1))
|
||||
mixed-text-fm))]
|
||||
}
|
||||
|
||||
|
||||
@close-eval[flomap-eval]
|
||||
|
|
|
|||
BIN
collects/images/scribblings/images/state-of-the-union.jpg
Normal file
BIN
collects/images/scribblings/images/state-of-the-union.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 82 KiB |
|
|
@ -1,48 +1,43 @@
|
|||
#lang racket/gui
|
||||
|
||||
(require images/gui
|
||||
images/compile-time
|
||||
(for-syntax racket/flonum racket/math
|
||||
images/private/flomap
|
||||
images/logos)
|
||||
images/private/flomap
|
||||
(require racket/math
|
||||
images/gui
|
||||
images/flomap
|
||||
images/logos)
|
||||
|
||||
(define frame-delay 1/30)
|
||||
|
||||
(begin-for-syntax
|
||||
(define size 256)
|
||||
(define blur 8)
|
||||
(define frame-num 10)
|
||||
(define end-frame-quality 90)
|
||||
(define mid-frame-quality 35)
|
||||
|
||||
(define background-fm (make-flomap* size size (flvector 1.0 1.0 1.0 1.0)))
|
||||
|
||||
(define plt-fm
|
||||
(flomap-shadowed (flomap-inset (plt-flomap (- size (* 4 blur))) (* 2 blur))
|
||||
blur (flvector 0.0 0.0 0.1)))
|
||||
|
||||
(define racket-fm
|
||||
(flomap-shadowed (flomap-inset (racket-flomap (- size (* 4 blur))) (* 2 blur))
|
||||
blur (flvector 0.1 0.0 0.0)))
|
||||
|
||||
(define logo-flomap* (flomap-whirl-morph plt-fm racket-fm))
|
||||
|
||||
(define (logo-flomap t)
|
||||
(flomap-cc-superimpose background-fm (logo-flomap* t))))
|
||||
(define size 256)
|
||||
(define blur 8)
|
||||
(define frame-num 10)
|
||||
(define end-frame-quality 90)
|
||||
(define mid-frame-quality 35)
|
||||
|
||||
(define background-fm (make-flomap* size size #(1 1 1 1)))
|
||||
|
||||
(define (flomap-shadowed fm σ color)
|
||||
(flomap-cc-superimpose (flomap-shadow fm σ color) fm))
|
||||
|
||||
(define plt-fm
|
||||
(flomap-shadowed (flomap-inset (plt-flomap (- size (* 4 blur))) (* 2 blur))
|
||||
blur #(1/2 0 0 1/8)))
|
||||
|
||||
(define racket-fm
|
||||
(flomap-shadowed (flomap-inset (racket-flomap (- size (* 4 blur))) (* 2 blur))
|
||||
blur #(1/2 1/8 0 0)))
|
||||
|
||||
(define logo-flomap* (flomap-whirl-morph plt-fm racket-fm))
|
||||
|
||||
(define (logo-flomap t)
|
||||
(flomap-cc-superimpose background-fm (logo-flomap* t)))
|
||||
|
||||
(define logo-frames
|
||||
(time
|
||||
(append (list (compiled-bitmap (time (flomap->bitmap (logo-flomap 0)))
|
||||
end-frame-quality))
|
||||
(compiled-bitmap-list
|
||||
(time
|
||||
(for/list ([t (in-range 1 frame-num)])
|
||||
(flomap->bitmap (logo-flomap (/ t frame-num)))))
|
||||
mid-frame-quality)
|
||||
(list (compiled-bitmap (time (flomap->bitmap (logo-flomap 1)))
|
||||
end-frame-quality)))))
|
||||
(append (list (time (flomap->bitmap (logo-flomap 0))))
|
||||
(time
|
||||
(for/list ([t (in-range 1 frame-num)])
|
||||
(flomap->bitmap (logo-flomap (/ t frame-num)))))
|
||||
(list (time (flomap->bitmap (logo-flomap 1)))))))
|
||||
|
||||
(define frame (new frame% [label "Whirl Morph Logo"] [width 256] [height 256]))
|
||||
(define canvas (make-object bitmap-canvas% frame (first logo-frames)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user