From 331b3b835133f569220789107fdd67ba6046d747 Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Wed, 30 May 2012 17:31:29 -0600 Subject: [PATCH] Fixed some transforms, stubbed out docs and examples for the same --- collects/images/private/flomap-transform.rkt | 94 +++++++++++--------- collects/images/scribblings/flomap.scrbl | 89 ++++++++++++++++-- 2 files changed, 136 insertions(+), 47 deletions(-) diff --git a/collects/images/private/flomap-transform.rkt b/collects/images/private/flomap-transform.rkt index 1b0374fb19..9166b7c6f3 100644 --- a/collects/images/private/flomap-transform.rkt +++ b/collects/images/private/flomap-transform.rkt @@ -1,13 +1,15 @@ #lang typed/racket/base (require racket/match racket/math - (only-in racket/unsafe/ops unsafe-flvector-ref) + (only-in racket/unsafe/ops + unsafe-flvector-ref + unsafe-fx+ unsafe-fx-) "flonum.rkt" "flomap-struct.rkt") (provide flomap-flip-horizontal flomap-flip-vertical flomap-transpose - flomap-cw-rotate flomap-ccw-rotate - (struct-out invertible-2d-function) Flomap-Transform + 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 ) @@ -17,13 +19,13 @@ (match-define (flomap vs c w h) fm) (define w-1 (fx- w 1)) (inline-build-flomap c w h (λ (k x y _i) - (unsafe-flvector-ref vs (coords->index c w k (fx- w-1 x) y))))) + (unsafe-flvector-ref vs (coords->index c w k (unsafe-fx- w-1 x) y))))) (define (flomap-flip-vertical fm) (match-define (flomap vs c w h) fm) (define h-1 (fx- h 1)) (inline-build-flomap c w h (λ (k x y _i) - (unsafe-flvector-ref vs (coords->index c w k x (fx- h-1 y)))))) + (unsafe-flvector-ref vs (coords->index c w k x (unsafe-fx- h-1 y)))))) (define (flomap-transpose fm) (match-define (flomap vs c w h) fm) @@ -32,31 +34,35 @@ (define (flomap-cw-rotate fm) (match-define (flomap vs c w h) fm) - (define h-1 (fx- h 1)) + (define w-1 (fx- w 1)) (inline-build-flomap c h w (λ (k x y _i) - (unsafe-flvector-ref vs (coords->index c w k (fx- h-1 y) x))))) + (unsafe-flvector-ref vs (coords->index c w k (unsafe-fx- w-1 y) x))))) (define (flomap-ccw-rotate fm) (match-define (flomap vs c w h) fm) - (define w-1 (fx- w 1)) + (define h-1 (fx- h 1)) (inline-build-flomap c h w (λ (k x y _i) - (unsafe-flvector-ref vs (coords->index c w k y (fx- w-1 x)))))) + (unsafe-flvector-ref vs (coords->index c w k y (unsafe-fx- h-1 x)))))) -(struct: invertible-2d-function ([f : (Flonum Flonum -> (values Flonum Flonum))] - [g : (Flonum Flonum -> (values Flonum Flonum))])) +(: flomap-rotate (flomap Real -> flomap)) +(define (flomap-rotate fm θ) + (flomap-transform fm (rotate-transform θ))) -(define-type Flomap-Transform (Integer Integer -> invertible-2d-function)) +(struct: invertible-2d-mapping ([fun : (Flonum Flonum -> (values Flonum Flonum))] + [inv : (Flonum Flonum -> (values Flonum Flonum))])) + +(define-type Flomap-Transform (Integer Integer -> invertible-2d-mapping)) (: transform-compose (Flomap-Transform Flomap-Transform -> Flomap-Transform)) (define ((transform-compose t1 t2) w h) - (match-define (invertible-2d-function f1 g1) (t1 w h)) - (match-define (invertible-2d-function f2 g2) (t2 w h)) - (invertible-2d-function (λ: ([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))))) + (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))))) (: flomap-transform (case-> (flomap Flomap-Transform -> flomap) (flomap Flomap-Transform Real Real Real Real -> flomap))) @@ -64,45 +70,53 @@ (case-lambda [(fm t) (match-define (flomap vs c w h) fm) - (match-define (invertible-2d-function f g) (t w h)) + (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 : Integer 0]) + (let: y-loop : Void ([y : Fixnum 0]) (when (y . fx< . h) - (let: x-loop : Void ([x : Integer 0]) + (let: x-loop : Void ([x : Fixnum 0]) (cond [(x . fx< . w) - (define-values (new-x new-y) (f (+ 0.5 (fx->fl x)) (+ 0.5 (fx->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 (fx+ x 1))] + (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)))) + (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 (fx+ y 1))])))) - (flomap-transform fm t x-min x-max y-min y-max)] - [(fm t x-min x-max y-min y-max) + (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)] - [x-max (exact->inexact x-max)] [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-function f g) (t w h)) + (match-define (invertible-2d-mapping f g) (t w h)) (define int-x-min (fl->fx (floor x-min))) - (define int-x-max (fl->fx (ceiling x-max))) (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 + (inline-build-flomap* c new-w new-h - (λ (k x y _i) + (λ (x y _i) (define-values (old-x old-y) (g (+ (fx->fl x) x-offset) (+ (fx->fl y) y-offset))) - (flomap-bilinear-ref fm k old-x old-y))))])) + (flomap-bilinear-ref* fm old-x old-y))))])) (: rotate-transform (Real -> Flomap-Transform)) (define ((rotate-transform θ) w h) @@ -111,7 +125,7 @@ (define sin-θ (sin θ)) (define x-mid (* 0.5 (->fl w))) (define y-mid (* 0.5 (->fl h))) - (invertible-2d-function + (invertible-2d-mapping (λ: ([x : Flonum] [y : Flonum]) (let ([x (- x x-mid)] [y (- y y-mid)]) @@ -164,6 +178,6 @@ (: whirl-and-pinch-transform (Real Real Real -> Flomap-Transform)) (define ((whirl-and-pinch-transform θ pinch radius) w h) - (invertible-2d-function + (invertible-2d-mapping (whirl-and-pinch-function (- θ) (- pinch) radius w h) (whirl-and-pinch-function θ pinch radius w h))) diff --git a/collects/images/scribblings/flomap.scrbl b/collects/images/scribblings/flomap.scrbl index 8e8cc19530..edd9c1a23c 100644 --- a/collects/images/scribblings/flomap.scrbl +++ b/collects/images/scribblings/flomap.scrbl @@ -9,6 +9,11 @@ images/flomap slideshow/pict) +@(require (for-label (only-in typed/racket + Integer Float Nonnegative-Fixnum Real Boolean + FlVector Vectorof + U Any Option))) + @(define flomap-eval (make-base-eval)) @interaction-eval[#:eval flomap-eval (require racket racket/flonum images/flomap)] @@ -383,11 +388,12 @@ The function @racket[f] receives three arguments @racket[k] @racket[x] @racket[y (sqr (- y 50)))))))))) (flomap->bitmap sine-fm)] -To build a flomap from a function that returns vectors, see @racket[build-flomap*]. +To build a flomap using a function that returns vectors, see @racket[build-flomap*]. } @defproc[(build-flomap* [c Integer] [w Integer] [h Integer] - [f (Nonnegative-Fixnum Nonnegative-Fixnum -> (U (Vectorof Real) FlVector))]) flomap]{ + [f (Nonnegative-Fixnum Nonnegative-Fixnum + -> (U (Vectorof Real) FlVector))]) flomap]{ Returns a @racket[w]×@racket[h] flomap with @racket[c] color components. Its values are defined by @racket[f], which returns vectors of point components. The vectors returned by @racket[f] must be length @racket[c]. @@ -445,7 +451,7 @@ First, the @racket[f] passed to @racket[inline-build-flomap] can be a macro. Second, it receives arguments @racket[k] @racket[x] @racket[y] @racket[i], where @racket[i] is a precalculated index into the result's @racketid[values]. Third, it must return a @racket[Float]. -Using @racket[inline-build-flomap] instead of @racket[build-flomap] often ensures that @racket[f] is inlined, and therefore floats remain unboxed. +Using @racket[inline-build-flomap] instead of @racket[build-flomap] may ensure that @racket[f] is inlined, and therefore floats remain unboxed. Many library functions use @racket[inline-build-flomap] internally for speed, notably @racket[fm+] and the other pointwise arithmetic operators. @bold{This is not available in untyped Racket.} @@ -585,7 +591,7 @@ Because @racket[fm] is an alpha-multiplied flomap (see @secref{flomap:opacity}), @interaction[#:eval flomap-eval (flomap->bitmap (fm* fm 0.2))] -@defproc[(flomap-lift2 [f (Flonum Flonum -> Real)]) ((U Real flomap) (U Real flomap) -> flomap)]{ +@defproc[(flomap-lift2 [f (Float Float -> Real)]) ((U Real flomap) (U Real flomap) -> flomap)]{ Lifts a binary floating-point function to operate pointwise on flomaps, allowing the same argument combinations as @racket[fm+] and others. } @@ -593,7 +599,7 @@ Lifts a binary floating-point function to operate pointwise on flomaps, allowing A macro version of @racket[flomap-lift]. The function or macro @racket[f] must return a @racket[Float], not a @racket[Real] as the @racket[f] argument to @racket[flomap-lift] can. -Using @racket[inline-flomap-lift] instead of @racket[flomap-lift] often ensures that @racket[f] is inlined, and therefore floats remain unboxed. +Using @racket[inline-flomap-lift] instead of @racket[flomap-lift] may ensure that @racket[f] is inlined, and therefore floats remain unboxed. @bold{This is not available in untyped Racket.} } @@ -602,7 +608,7 @@ Using @racket[inline-flomap-lift] instead of @racket[flomap-lift] often ensures A macro version of @racket[flomap-lift2]. The function or macro @racket[f] must return a @racket[Float], not a @racket[Real] as the @racket[f] argument to @racket[flomap-lift2] can. -Using @racket[inline-flomap-lift2] instead of @racket[flomap-lift2] often ensures that @racket[f] is inlined, and therefore floats remain unboxed. +Using @racket[inline-flomap-lift2] instead of @racket[flomap-lift2] may ensure that @racket[f] is inlined, and therefore floats remain unboxed. @bold{This is not available in untyped Racket.} } @@ -879,7 +885,76 @@ See @racket[flomap-pin] and @racket[flomap-pin*] for implementation details. @; =================================================================================================== -@;@section{Transformations} +@section{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. +@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))] +} + +@defproc[(flomap-rotate [fm flomap] [θ Real]) flomap]{ +Equivalent to @racket[(flomap-transform fm (rotate-transform θ))]. +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-rotate hello-fm (* 1/4 pi)))] +} + +@defstruct*[invertible-2d-mapping ([fun (Float Float -> (values Float Float))] + [inv (Float Float -> (values Float Float))])]{ +} + +@defidform[Flomap-Transform]{ +Defined as @racket[(Integer Integer -> invertible-2d-mapping)]. +} + +@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]) + flomap])]{ +} + +@defproc[(rotate-transform [θ Real]) Flomap-Transform]{ +rotates around center; positive is screen-clockwise +} + +@defproc[(whirl-and-pinch-transform [θ Real] [pinch Real] [radius Real]) Flomap-Transform]{ +} + +@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)] + +@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)))] +} @; ===================================================================================================