Fixed some transforms, stubbed out docs and examples for the same
This commit is contained in:
Neil Toronto
parent
e8645598d7
commit
331b3b8351
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))]
|
||||
}
|
||||
|
||||
|
||||
@; ===================================================================================================
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user