From c7bea1dfcd323b9dcd90e795ca7a68dde26cf5cf Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Tue, 29 May 2012 17:50:32 -0600 Subject: [PATCH] images/flomap: public interface to floating-point bitmaps used by ray tracer --- collects/images/flomap.rkt | 5 + collects/images/icons/arrow.rkt | 34 +- collects/images/icons/control.rkt | 54 +- collects/images/icons/file.rkt | 92 +-- collects/images/icons/misc.rkt | 399 +++++---- collects/images/icons/stickman.rkt | 149 ++-- collects/images/icons/style.rkt | 18 +- collects/images/icons/symbol.rkt | 94 ++- collects/images/logos.rkt | 140 ++-- collects/images/private/draw-predicates.rkt | 11 - collects/images/private/flomap-blur.rkt | 24 +- collects/images/private/flomap-composite.rkt | 147 ++-- collects/images/private/flomap-convert.rkt | 4 +- collects/images/private/flomap-effects.rkt | 18 +- collects/images/private/flomap-gradient.rkt | 4 +- collects/images/private/flomap-pointwise.rkt | 5 +- collects/images/private/flomap-resize.rkt | 87 +- collects/images/private/flomap-struct.rkt | 13 +- collects/images/private/flomap.rkt | 12 +- collects/images/scribblings/flomap.scrbl | 817 +++++++++++++++++++ collects/images/scribblings/images.scrbl | 9 +- collects/images/tests/effects-tests.rkt | 6 +- 22 files changed, 1493 insertions(+), 649 deletions(-) create mode 100644 collects/images/flomap.rkt delete mode 100644 collects/images/private/draw-predicates.rkt create mode 100644 collects/images/scribblings/flomap.scrbl diff --git a/collects/images/flomap.rkt b/collects/images/flomap.rkt new file mode 100644 index 0000000000..22f2930f03 --- /dev/null +++ b/collects/images/flomap.rkt @@ -0,0 +1,5 @@ +#lang typed/racket/base + +(require "private/flomap.rkt") + +(provide (all-from-out "private/flomap.rkt")) diff --git a/collects/images/icons/arrow.rkt b/collects/images/icons/arrow.rkt index 732c1a2489..9c5b36283d 100644 --- a/collects/images/icons/arrow.rkt +++ b/collects/images/icons/arrow.rkt @@ -25,28 +25,28 @@ ) flomap? (let ([color (->color% color)]) (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-polygon (list '(0 . 9) '(15 . 9) '(14 . 0) - '(31 . 15.5) - '(14 . 31) '(15 . 22) '(0 . 22)))) - (/ height 32)))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-polygon (list '(0 . 9) '(15 . 9) '(14 . 0) + '(31 . 15.5) + '(14 . 31) '(15 . 22) '(0 . 22)))) + 32 32 (/ height 32)))) (defproc (flat-right-over-arrow-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0))] ) flomap? (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc '((m 0 15) - (c 9 -14 19.5 -8 24 -2) - (l 5 -7 2 20 -20 -2 7 -5) - (c -2.5 -4 -8 -8.5 -14 0) - (l -4 -4)) - 0 0)) - (/ height 32))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc '((m 0 15) + (c 9 -14 19.5 -8 24 -2) + (l 5 -7 2 20 -20 -2 7 -5) + (c -2.5 -4 -8 -8.5 -14 0) + (l -4 -4)) + 0 0)) + 32 32 (/ height 32))) (defproc (right-arrow-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] diff --git a/collects/images/icons/control.rkt b/collects/images/icons/control.rkt index f3bf9841b7..d1e621f57e 100644 --- a/collects/images/icons/control.rkt +++ b/collects/images/icons/control.rkt @@ -26,14 +26,13 @@ (define (flat-play-flomap color height) (draw-icon-flomap - 24 32 (λ (dc) (set-icon-pen dc (icon-color->outline-color color) 1 'solid) (send dc set-brush color 'solid) (send dc draw-polygon (list (cons 0 0) (cons 4 0) (cons 23 13) (cons 23 18) (cons 4 31) (cons 0 31)))) - (/ height 32))) + 24 32 (/ height 32))) (defproc (play-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] @@ -50,15 +49,15 @@ ) flomap? (make-cached-flomap [height color material] - (define fm (draw-rendered-icon-flomap - 20 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-polygon (list (cons 0 0) (cons 4 0) - (cons 19 13) (cons 19 18) - (cons 4 31) (cons 0 31)))) - (/ height 32) - material)) + (define fm + (draw-rendered-icon-flomap + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-polygon (list (cons 0 0) (cons 4 0) + (cons 19 13) (cons 19 18) + (cons 4 31) (cons 0 31)))) + 20 32 (/ height 32) material)) (flomap-hc-append fm fm))) (defproc (stop-flomap [color (or/c string? (is-a?/c color%))] @@ -68,12 +67,11 @@ (make-cached-flomap [height color material] (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-polygon (list '(0 . 0) '(31 . 0) '(31 . 31) '(0 . 31)))) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-polygon (list '(0 . 0) '(31 . 0) '(31 . 31) '(0 . 31)))) + 32 32 (/ height 32) material))) (defproc (record-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] @@ -82,12 +80,11 @@ (make-cached-flomap [height color material] (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-ellipse 0 0 31 31)) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-ellipse 0 0 31 31)) + 32 32 (/ height 32) material))) (defproc (bar-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] @@ -96,12 +93,11 @@ (make-cached-flomap [height color material] (draw-rendered-icon-flomap - 8 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-polygon (list '(0 . 0) '(7 . 0) '(7 . 31) '(0 . 31)))) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-polygon (list '(0 . 0) '(7 . 0) '(7 . 31) '(0 . 31)))) + 8 32 (/ height 32) material))) (defproc (back-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] diff --git a/collects/images/icons/file.rkt b/collects/images/icons/file.rkt index 18ca17c374..38e1f8dd4e 100644 --- a/collects/images/icons/file.rkt +++ b/collects/images/icons/file.rkt @@ -26,20 +26,20 @@ (define metal-fm (let* ([fm (draw-icon-flomap - 18 11 (λ (dc) - (send dc set-background "lightgray") - (define outer-path (new dc-path%)) - (send outer-path rounded-rectangle 0.5 0.5 13 12 1) - (define inner-path (new dc-path%)) - (send inner-path rectangle 2.5 2.5 4 6) - (define outer-rgn (new region%)) - (send outer-rgn set-path outer-path) - (define inner-rgn (new region%)) - (send inner-rgn set-path inner-path) - (send outer-rgn subtract inner-rgn) - (send dc set-clipping-region outer-rgn) - (send dc clear)) - scale)] + (λ (dc) + (send dc set-background "lightgray") + (define outer-path (new dc-path%)) + (send outer-path rounded-rectangle 0.5 0.5 13 12 1) + (define inner-path (new dc-path%)) + (send inner-path rectangle 2.5 2.5 4 6) + (define outer-rgn (new region%)) + (send outer-rgn set-path outer-path) + (define inner-rgn (new region%)) + (send inner-rgn set-path inner-path) + (send outer-rgn subtract inner-rgn) + (send dc set-clipping-region outer-rgn) + (send dc clear)) + 18 11 scale)] [dfm (flomap->deep-flomap fm)] [dfm (deep-flomap-icon-style dfm)] [dfm (deep-flomap-scale-z dfm 1/16)]) @@ -47,50 +47,50 @@ (define bottom-indent-fm (draw-icon-flomap - 20 11 (λ (dc) - (send dc set-alpha 1/4) - (send dc set-pen "black" 1 'transparent) - (send dc set-brush "black" 'solid) - (send dc draw-rounded-rectangle 1.5 0.5 18 11 1)) - scale)) + (λ (dc) + (send dc set-alpha 1/4) + (send dc set-pen "black" 1 'transparent) + (send dc set-brush "black" 'solid) + (send dc draw-rounded-rectangle 1.5 0.5 18 11 1)) + 20 11 scale)) (define label-fm (let* ([fm (draw-icon-flomap - 22 20 (λ (dc) - (send dc set-pen "black" 1 'transparent) - (send dc set-brush "black" 'solid) - (send dc draw-rounded-rectangle -0.5 -3.5 22 21 3) - (send dc set-brush "lemonchiffon" 'solid) - (send dc draw-rounded-rectangle 0.5 -3.5 20 20 2) - (send dc set-brush "chocolate" 'solid) - (send dc draw-rectangle 0.5 -0.5 20 4) - (send dc set-brush "navy" 'solid) - (for ([i (in-range 5.5 15 3)]) - (send dc draw-rectangle 2.5 i 16 1))) - scale)] + (λ (dc) + (send dc set-pen "black" 1 'transparent) + (send dc set-brush "black" 'solid) + (send dc draw-rounded-rectangle -0.5 -3.5 22 21 3) + (send dc set-brush "lemonchiffon" 'solid) + (send dc draw-rounded-rectangle 0.5 -3.5 20 20 2) + (send dc set-brush "chocolate" 'solid) + (send dc draw-rectangle 0.5 -0.5 20 4) + (send dc set-brush "navy" 'solid) + (for ([i (in-range 5.5 15 3)]) + (send dc draw-rectangle 2.5 i 16 1))) + 22 20 scale)] [dfm (flomap->deep-flomap fm)] [dfm (deep-flomap-bulge-vertical dfm (* 2 scale))]) (deep-flomap-render-icon dfm matte-material))) (define top-indent-fm (draw-icon-flomap - 22 19 (λ (dc) - (send dc set-alpha 1) - (send dc set-pen "black" 1 'transparent) - (send dc set-brush "black" 'solid) - (send dc draw-rounded-rectangle -0.5 -2.5 22 20 2.5)) - scale)) + (λ (dc) + (send dc set-alpha 1) + (send dc set-pen "black" 1 'transparent) + (send dc set-brush "black" 'solid) + (send dc draw-rounded-rectangle -0.5 -2.5 22 20 2.5)) + 22 19 scale)) (define case-fm (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-polygon (list '(0 . 3) '(3 . 0) - '(28 . 0) '(31 . 3) - '(31 . 28) '(28 . 31) - '(3 . 31) '(0 . 28)))) - scale)) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-polygon (list '(0 . 3) '(3 . 0) + '(28 . 0) '(31 . 3) + '(31 . 28) '(28 . 31) + '(3 . 31) '(0 . 28)))) + 32 32 scale)) (define disk-fm (let* ([dfm (deep-flomap-ct-superimpose diff --git a/collects/images/icons/misc.rkt b/collects/images/icons/misc.rkt index 7f3d07f3ac..95d1aab667 100644 --- a/collects/images/icons/misc.rkt +++ b/collects/images/icons/misc.rkt @@ -27,17 +27,17 @@ (define (flat-regular-polygon-flomap sides start color size) (let ([start (- start)]) (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (define dθ (/ (* 2 pi) sides)) - (define θs (sequence->list (in-range start (+ start (* 2 pi)) dθ))) - (define max-frac (apply max (append (map (compose abs cos) θs) - (map (compose abs sin) θs)))) - (send dc draw-polygon (for/list ([θ (in-list θs)]) - (cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac)) - (+ 15.5 (/ (* 15.5 (sin θ)) max-frac)))))) - (/ size 32)))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (define dθ (/ (* 2 pi) sides)) + (define θs (sequence->list (in-range start (+ start (* 2 pi)) dθ))) + (define max-frac (apply max (append (map (compose abs cos) θs) + (map (compose abs sin) θs)))) + (send dc draw-polygon (for/list ([θ (in-list θs)]) + (cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac)) + (+ 15.5 (/ (* 15.5 (sin θ)) max-frac)))))) + 32 32 (/ size 32)))) (defproc (regular-polygon-flomap [sides exact-positive-integer?] [start real?] @@ -83,17 +83,16 @@ (make-cached-flomap [height color material] (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (send dc draw-ellipse 4 8 23 23) - (send dc draw-ellipse 0 10 4 3.5) - (send dc draw-ellipse 3 4.5 4.5 4.5) - (send dc draw-ellipse 8.75 1 5.25 5.25) - (send dc draw-ellipse 16 0 6 6) - (send dc draw-ellipse 23.5 1.5 7.5 9)) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (send dc draw-ellipse 4 8 23 23) + (send dc draw-ellipse 0 10 4 3.5) + (send dc draw-ellipse 3 4.5 4.5 4.5) + (send dc draw-ellipse 8.75 1 5.25 5.25) + (send dc draw-ellipse 16 0 6 6) + (send dc draw-ellipse 23.5 1.5 7.5 9)) + 32 32 (/ height 32) material))) ;; --------------------------------------------------------------------------------------------------- ;; Magnifying glass @@ -115,11 +114,11 @@ (define scale (/ height 32)) (define glass-fm (let* ([fm (draw-icon-flomap - 18 18 (λ (dc) - (set-icon-pen dc (icon-color->outline-color "azure") 1 'solid) - (send dc set-brush "azure" 'solid) - (send dc draw-ellipse 0 0 17 17)) - scale)] + (λ (dc) + (set-icon-pen dc (icon-color->outline-color "azure") 1 'solid) + (send dc set-brush "azure" 'solid) + (send dc draw-ellipse 0 0 17 17)) + 18 18 scale)] [dfm (flomap->deep-flomap fm)] [dfm (deep-flomap-bulge-spheroid dfm (* 4 scale))] [dfm (deep-flomap-raise dfm (* 4 scale))]) @@ -127,21 +126,21 @@ (define circle-fm (let* ([fm (draw-icon-flomap - 28 28 (λ (dc) - (define outline-color (icon-color->outline-color frame-color)) - (send dc set-pen outline-color 3 'solid) - (send dc set-brush outline-color 'solid) - (send dc draw-ellipse 1 1 25 25) - (send dc set-pen frame-color 1 'solid) - (send dc set-brush frame-color 'solid) - (send dc draw-ellipse 1 1 25 25)) - scale)] + (λ (dc) + (define outline-color (icon-color->outline-color frame-color)) + (send dc set-pen outline-color 3 'solid) + (send dc set-brush outline-color 'solid) + (send dc draw-ellipse 1 1 25 25) + (send dc set-pen frame-color 1 'solid) + (send dc set-brush frame-color 'solid) + (send dc draw-ellipse 1 1 25 25)) + 28 28 scale)] [indent-fm (draw-icon-flomap - 28 28 (λ (dc) - (send dc set-pen frame-color 1 'solid) - (send dc set-brush frame-color 'solid) - (send dc draw-ellipse 5 5 17 17)) - scale)] + (λ (dc) + (send dc set-pen frame-color 1 'solid) + (send dc set-brush frame-color 'solid) + (send dc draw-ellipse 5 5 17 17)) + 28 28 scale)] [indent-dfm (flomap->deep-flomap indent-fm)] [indent-dfm (deep-flomap-raise indent-dfm (* -4 scale))] [dfm (flomap->deep-flomap fm)] @@ -152,17 +151,17 @@ (define handle-fm (let* ([fm (draw-icon-flomap - 11 11 (λ (dc) - (set-icon-pen dc (icon-color->outline-color handle-color) 1 'solid) - (send dc set-brush handle-color 'solid) - (define p (new dc-path%)) - (send p move-to 4 0) - (send p line-to 10 5) - (send p curve-to 10 8 8 10 5 10) - (send p line-to 0 4) - (send p move-to 4 0) - (send dc draw-path p)) - scale)]) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color handle-color) 1 'solid) + (send dc set-brush handle-color 'solid) + (define p (new dc-path%)) + (send p move-to 4 0) + (send p line-to 10 5) + (send p curve-to 10 8 8 10 5 10) + (send p line-to 0 4) + (send p move-to 4 0) + (send dc draw-path p)) + 11 11 scale)]) (flomap-render-icon fm material))) (flomap-pin* 0 0 21/28 21/28 @@ -189,20 +188,20 @@ (define scale (/ height 32)) (define fuse-fm (let* ([fm (draw-icon-flomap - 10 25 (λ (dc) - (send dc set-pen "darkred" 1 'solid) - (send dc set-brush "gold" 'solid) - (draw-path-commands dc '((m 3.5 0) - (c -5 0 -3.29080284 10.4205 -3 11.5 - 1.1137011 4.1343 2 6.5 0 8.5 - -0.5711131 2.0524 1.5 4 3.5 3.5 - 2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5 - -2 -7 -2 -9 -1.5 -9 - 0 1 -0.5 2 1 3.5 - 2 0.5 4 -1.5 3.5 -3.5 - -2 -2 -2 -5 -5.5 -5)) - 0 0)) - scale)] + (λ (dc) + (send dc set-pen "darkred" 1 'solid) + (send dc set-brush "gold" 'solid) + (draw-path-commands dc '((m 3.5 0) + (c -5 0 -3.29080284 10.4205 -3 11.5 + 1.1137011 4.1343 2 6.5 0 8.5 + -0.5711131 2.0524 1.5 4 3.5 3.5 + 2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5 + -2 -7 -2 -9 -1.5 -9 + 0 1 -0.5 2 1 3.5 + 2 0.5 4 -1.5 3.5 -3.5 + -2 -2 -2 -5 -5.5 -5)) + 0 0)) + 10 25 scale)] [dfm (flomap->deep-flomap fm)] [dfm (deep-flomap-icon-style dfm)] [dfm (deep-flomap-scale-z dfm 1)]) @@ -210,19 +209,19 @@ (define (bomb-cap-flomap color) (draw-icon-flomap - 20 20 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc '((m 1.5 11.5) - (l 10 -10 2.5 2.5) - (c 4 5 -5 14 -10 10) - (l -2.5 -2.5)) - 0 0) - (draw-path-commands dc '((m 1.5 11.5) - (c -2 -5 5 -12 10 -10 - 4 5 -5 14 -10 10)) - 0 0)) - scale)) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc '((m 1.5 11.5) + (l 10 -10 2.5 2.5) + (c 4 5 -5 14 -10 10) + (l -2.5 -2.5)) + 0 0) + (draw-path-commands dc '((m 1.5 11.5) + (c -2 -5 5 -12 10 -10 + 4 5 -5 14 -10 10)) + 0 0)) + 20 20 scale)) (define cap-fm (let* ([cap-fm (bomb-cap-flomap cap-color)] @@ -232,11 +231,11 @@ (define sphere-fm (let* ([sphere-fm (draw-icon-flomap - 30 30 (λ (dc) - (set-icon-pen dc (icon-color->outline-color bomb-color) 1 'solid) - (send dc set-brush bomb-color 'solid) - (send dc draw-ellipse 0 0 29 29)) - scale)] + (λ (dc) + (set-icon-pen dc (icon-color->outline-color bomb-color) 1 'solid) + (send dc set-brush bomb-color 'solid) + (send dc draw-ellipse 0 0 29 29)) + 30 30 scale)] [cap-fm (bomb-cap-flomap cap-color)] [cap-dfm (flomap->deep-flomap cap-fm)] [cap-dfm (deep-flomap-raise cap-dfm (* -2 scale))] @@ -280,69 +279,67 @@ (flomap-cc-superimpose ;; face and ticks (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color (icon-color->outline-color face-color)) - 1 'solid) - (send dc set-brush face-color 'solid) - (send dc draw-ellipse 0 0 31 31) - (set-icon-pen dc "black" 1 'solid) - (for ([i (in-range 60)] - [r (in-cycle (list 1.5 .5 .5 .5 .5 - 1.0 .5 .5 .5 .5 - 1.0 .5 .5 .5 .5))] - [t (in-cycle (list 1.0 .25 .25 .25 .25 - .75 .25 .25 .25 .25 - .75 .25 .25 .25 .25))]) - (define θ (* i (* 1/30 pi))) - (set-icon-pen dc "black" t 'solid) - (send dc draw-line - (+ 15.5 (* (- R r) (cos θ))) - (+ 15.5 (* (- R r) (sin θ))) - (+ 15.5 (* R (cos θ))) - (+ 15.5 (* R (sin θ)))))) - scale) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color (icon-color->outline-color face-color)) + 1 'solid) + (send dc set-brush face-color 'solid) + (send dc draw-ellipse 0 0 31 31) + (set-icon-pen dc "black" 1 'solid) + (for ([i (in-range 60)] + [r (in-cycle (list 1.5 .5 .5 .5 .5 + 1.0 .5 .5 .5 .5 + 1.0 .5 .5 .5 .5))] + [t (in-cycle (list 1.0 .25 .25 .25 .25 + .75 .25 .25 .25 .25 + .75 .25 .25 .25 .25))]) + (define θ (* i (* 1/30 pi))) + (set-icon-pen dc "black" t 'solid) + (send dc draw-line + (+ 15.5 (* (- R r) (cos θ))) + (+ 15.5 (* (- R r) (sin θ))) + (+ 15.5 (* R (cos θ))) + (+ 15.5 (* R (sin θ)))))) + 32 32 scale) ;; lambda logo (fm* 0.33 (lambda-flomap face-color (* 1/2 height) glass-icon-material)) ;; minute hand (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) - (send dc set-brush hand-color 'solid) - (send dc draw-polygon - (list (cons (+ 15.5 (* R (cos minute-θ))) - (+ 15.5 (* R (sin minute-θ)))) - (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 1/2 pi))))) - (+ 15.5 (* 1 (sin (+ minute-θ (* 1/2 pi)))))) - (cons (+ 15.5 (* 1 (cos (+ minute-θ pi)))) - (+ 15.5 (* 1 (sin (+ minute-θ pi))))) - (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 3/2 pi))))) - (+ 15.5 (* 1 (sin (+ minute-θ (* 3/2 pi))))))))) - scale - metal-icon-material) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) + (send dc set-brush hand-color 'solid) + (send dc draw-polygon + (list (cons (+ 15.5 (* R (cos minute-θ))) + (+ 15.5 (* R (sin minute-θ)))) + (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 1/2 pi))))) + (+ 15.5 (* 1 (sin (+ minute-θ (* 1/2 pi)))))) + (cons (+ 15.5 (* 1 (cos (+ minute-θ pi)))) + (+ 15.5 (* 1 (sin (+ minute-θ pi))))) + (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 3/2 pi))))) + (+ 15.5 (* 1 (sin (+ minute-θ (* 3/2 pi))))))))) + 32 32 scale metal-icon-material) ;; hour hand (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) - (send dc set-brush hand-color 'solid) - (send dc draw-polygon - (list (cons (+ 15.5 (* (- R 5) (cos hour-θ))) - (+ 15.5 (* (- R 5) (sin hour-θ)))) - (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 1/2 pi))))) - (+ 15.5 (* 1.25 (sin (+ hour-θ (* 1/2 pi)))))) - (cons (+ 15.5 (* 1.25 (cos (+ hour-θ pi)))) - (+ 15.5 (* 1.25 (sin (+ hour-θ pi))))) - (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 3/2 pi))))) - (+ 15.5 (* 1.25 (sin (+ hour-θ (* 3/2 pi))))))))) - scale - metal-icon-material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) + (send dc set-brush hand-color 'solid) + (send dc draw-polygon + (list (cons (+ 15.5 (* (- R 5) (cos hour-θ))) + (+ 15.5 (* (- R 5) (sin hour-θ)))) + (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 1/2 pi))))) + (+ 15.5 (* 1.25 (sin (+ hour-θ (* 1/2 pi)))))) + (cons (+ 15.5 (* 1.25 (cos (+ hour-θ pi)))) + (+ 15.5 (* 1.25 (sin (+ hour-θ pi))))) + (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 3/2 pi))))) + (+ 15.5 (* 1.25 (sin (+ hour-θ (* 3/2 pi))))))))) + 32 32 scale metal-icon-material))) (define shell-fm (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc "white" 1 'solid) - (send dc set-brush "white" 'solid) - (send dc draw-ellipse 1 1 29 29)) - scale)) + (λ (dc) + (set-icon-pen dc "white" 1 'solid) + (send dc set-brush "white" 'solid) + (send dc draw-ellipse 1 1 29 29)) + 32 32 scale)) (let* ([dfm (flomap->deep-flomap shell-fm)] [dfm (deep-flomap-bulge-spheroid dfm (* 9 scale))] @@ -362,17 +359,16 @@ (define clock-fm (clock-flomap (* 30/32 height) face-color hand-color hours minutes)) (define buttons-fm (draw-rendered-icon-flomap - 32 8 (λ (dc) - (set-icon-pen dc (make-object color% 128 0 0) 1 'solid) - (send dc set-brush (make-object color% 144 0 0) 'solid) - (send dc draw-polygon '((2 . 4) (4 . 2) (31 . 31))) - (send dc draw-polygon '((0 . 5) (5 . 0) (6 . 1) (1 . 6))) - (set-icon-pen dc "black" 1 'solid) - (send dc set-brush (make-object color% 16 16 16) 'solid) - (send dc draw-polygon '((28.5 . 5.5) (25.5 . 2.5) (0 . 31))) - (send dc draw-polygon '((31 . 5) (26 . 0) (24.5 . 1.5) (29.5 . 6.5)))) - (/ height 32) - metal-icon-material)) + (λ (dc) + (set-icon-pen dc (make-object color% 128 0 0) 1 'solid) + (send dc set-brush (make-object color% 144 0 0) 'solid) + (send dc draw-polygon '((2 . 4) (4 . 2) (31 . 31))) + (send dc draw-polygon '((0 . 5) (5 . 0) (6 . 1) (1 . 6))) + (set-icon-pen dc "black" 1 'solid) + (send dc set-brush (make-object color% 16 16 16) 'solid) + (send dc draw-polygon '((28.5 . 5.5) (25.5 . 2.5) (0 . 31))) + (send dc draw-polygon '((31 . 5) (26 . 0) (24.5 . 1.5) (29.5 . 6.5)))) + 32 8 (/ height 32) metal-icon-material)) (flomap-pin* 1/2 0 1/2 -2/32 buttons-fm clock-fm))) ;; --------------------------------------------------------------------------------------------------- @@ -410,33 +406,31 @@ (define scale (/ height 32)) (flomap-ct-superimpose (draw-rendered-icon-flomap - 32 32 (λ (dc) - (send dc set-pen (make-object pen% color 2 'solid 'round 'round)) - (send dc set-brush "white" 'transparent) - (draw-path-commands dc rubber-hose-commands 0 0) - (draw-path-commands dc rubber-t-commands 0 0) - (send dc set-pen (make-object pen% "black" 3 'solid 'round 'round)) - (send dc draw-line 23.5 1 25 1.5) - (send dc draw-line 7.5 1 6 1.5)) - scale - rubber-material) + (λ (dc) + (send dc set-pen (make-object pen% color 2 'solid 'round 'round)) + (send dc set-brush "white" 'transparent) + (draw-path-commands dc rubber-hose-commands 0 0) + (draw-path-commands dc rubber-t-commands 0 0) + (send dc set-pen (make-object pen% "black" 3 'solid 'round 'round)) + (send dc draw-line 23.5 1 25 1.5) + (send dc draw-line 7.5 1 6 1.5)) + 32 32 scale rubber-material) (draw-rendered-icon-flomap - 32 32 (λ (dc) - (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) - (send dc set-brush "white" 'transparent) - (draw-path-commands dc left-metal-commands 0 0) - (draw-path-commands dc right-metal-commands 0 0) - (send dc set-pen (make-object pen% metal-icon-color 2 'solid 'round 'round)) - (draw-path-commands dc left-metal-commands 0 0) - (draw-path-commands dc right-metal-commands 0 0) - (set-icon-pen dc dark-metal-icon-color 0.5 'solid) - (send dc set-brush metal-icon-color 'solid) - (send dc draw-ellipse 21.25 21.25 10 10) - (set-icon-pen dc dark-metal-icon-color 0.25 'solid) - (send dc set-brush light-metal-icon-color 'solid) - (send dc draw-ellipse 22.25 22.25 8 8)) - scale - metal-icon-material))) + (λ (dc) + (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) + (send dc set-brush "white" 'transparent) + (draw-path-commands dc left-metal-commands 0 0) + (draw-path-commands dc right-metal-commands 0 0) + (send dc set-pen (make-object pen% metal-icon-color 2 'solid 'round 'round)) + (draw-path-commands dc left-metal-commands 0 0) + (draw-path-commands dc right-metal-commands 0 0) + (set-icon-pen dc dark-metal-icon-color 0.5 'solid) + (send dc set-brush metal-icon-color 'solid) + (send dc draw-ellipse 21.25 21.25 10 10) + (set-icon-pen dc dark-metal-icon-color 0.25 'solid) + (send dc set-brush light-metal-icon-color 'solid) + (send dc draw-ellipse 22.25 22.25 8 8)) + 32 32 scale metal-icon-material))) (define short-rubber-t-commands '((m 3 12.5) @@ -455,36 +449,33 @@ (define scale (/ height 32)) (flomap-ct-superimpose (draw-rendered-icon-flomap - 32 32 (λ (dc) - (send dc translate 0 6) - (send dc set-pen (make-object pen% color 2 'solid 'round 'round)) - (send dc set-brush "white" 'transparent) - (draw-path-commands dc short-rubber-hose-commands 0 0) - (draw-path-commands dc short-rubber-t-commands 0 0) - (send dc set-pen (make-object pen% "black" 3 'solid 'round 'round)) - (send dc draw-line 4.5 1 3 1.5) - (send dc draw-line 26.5 1 28 1.5)) - scale - rubber-material) + (λ (dc) + (send dc translate 0 6) + (send dc set-pen (make-object pen% color 2 'solid 'round 'round)) + (send dc set-brush "white" 'transparent) + (draw-path-commands dc short-rubber-hose-commands 0 0) + (draw-path-commands dc short-rubber-t-commands 0 0) + (send dc set-pen (make-object pen% "black" 3 'solid 'round 'round)) + (send dc draw-line 4.5 1 3 1.5) + (send dc draw-line 26.5 1 28 1.5)) + 32 32 scale rubber-material) (draw-rendered-icon-flomap - 32 32 (λ (dc) - (send dc translate 0 6) - (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) - (send dc set-brush "white" 'transparent) - (draw-path-commands dc left-metal-commands -3 0) - (draw-path-commands dc right-metal-commands 3 0) - (send dc set-pen (make-object pen% metal-icon-color 2 'solid 'round 'round)) - (draw-path-commands dc left-metal-commands -3 0) - (draw-path-commands dc right-metal-commands 3 0) - (set-icon-pen dc dark-metal-icon-color 0.5 'solid) - (send dc set-brush metal-icon-color 'solid) - (send dc draw-ellipse 21.25 15.25 10 10) - (set-icon-pen dc dark-metal-icon-color 0.25 'solid) - (send dc set-brush light-metal-icon-color 'solid) - (send dc draw-ellipse 22.25 16.25 8 8) - ) - scale - metal-icon-material))) + (λ (dc) + (send dc translate 0 6) + (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) + (send dc set-brush "white" 'transparent) + (draw-path-commands dc left-metal-commands -3 0) + (draw-path-commands dc right-metal-commands 3 0) + (send dc set-pen (make-object pen% metal-icon-color 2 'solid 'round 'round)) + (draw-path-commands dc left-metal-commands -3 0) + (draw-path-commands dc right-metal-commands 3 0) + (set-icon-pen dc dark-metal-icon-color 0.5 'solid) + (send dc set-brush metal-icon-color 'solid) + (send dc draw-ellipse 21.25 15.25 10 10) + (set-icon-pen dc dark-metal-icon-color 0.25 'solid) + (send dc set-brush light-metal-icon-color 'solid) + (send dc draw-ellipse 22.25 16.25 8 8)) + 32 32 scale metal-icon-material))) ;; =================================================================================================== ;; Bitmaps (icons) diff --git a/collects/images/icons/stickman.rkt b/collects/images/icons/stickman.rkt index 489eeeabcd..332f5a8398 100644 --- a/collects/images/icons/stickman.rkt +++ b/collects/images/icons/stickman.rkt @@ -120,66 +120,62 @@ [height color arm-color head-color material] (flomap-lt-superimpose (draw-short-rendered-icon-flomap - 26 32 (λ (dc) - (send dc set-pen (icon-color->outline-color arm-color) - (+ arm-width (* 2 line-width)) 'solid) - (send dc draw-lines (list standing-right-shoulder-point - standing-right-elbow-point - standing-right-hand-point)) - (send dc set-pen arm-color arm-width 'solid) - (send dc draw-lines (list standing-right-shoulder-point - standing-right-elbow-point - standing-right-hand-point))) - (/ height 32) - material) + (λ (dc) + (send dc set-pen (icon-color->outline-color arm-color) + (+ arm-width (* 2 line-width)) 'solid) + (send dc draw-lines (list standing-right-shoulder-point + standing-right-elbow-point + standing-right-hand-point)) + (send dc set-pen arm-color arm-width 'solid) + (send dc draw-lines (list standing-right-shoulder-point + standing-right-elbow-point + standing-right-hand-point))) + 26 32 (/ height 32) material) (draw-short-rendered-icon-flomap - 26 32 (λ (dc) - (send dc set-pen (icon-color->outline-color color) - (+ body-width (* 2 line-width)) 'solid) - (send dc draw-lines (list standing-neck-point standing-hip-point)) - - (send dc set-pen (icon-color->outline-color color) - (+ leg-width (* 2 line-width)) 'solid) - (send dc draw-lines (list standing-hip-point - standing-left-knee-point - standing-left-foot-point)) - (send dc draw-lines (list standing-hip-point - standing-right-knee-point - standing-right-foot-point)) - - (send dc set-pen color body-width 'solid) - (send dc draw-lines (list standing-neck-point standing-hip-point)) - - (send dc set-pen color leg-width 'solid) - (send dc draw-lines (list standing-hip-point - standing-left-knee-point - standing-left-foot-point)) - (send dc draw-lines (list standing-hip-point - standing-right-knee-point - standing-right-foot-point))) - (/ height 32) - material) + (λ (dc) + (send dc set-pen (icon-color->outline-color color) + (+ body-width (* 2 line-width)) 'solid) + (send dc draw-lines (list standing-neck-point standing-hip-point)) + + (send dc set-pen (icon-color->outline-color color) + (+ leg-width (* 2 line-width)) 'solid) + (send dc draw-lines (list standing-hip-point + standing-left-knee-point + standing-left-foot-point)) + (send dc draw-lines (list standing-hip-point + standing-right-knee-point + standing-right-foot-point)) + + (send dc set-pen color body-width 'solid) + (send dc draw-lines (list standing-neck-point standing-hip-point)) + + (send dc set-pen color leg-width 'solid) + (send dc draw-lines (list standing-hip-point + standing-left-knee-point + standing-left-foot-point)) + (send dc draw-lines (list standing-hip-point + standing-right-knee-point + standing-right-foot-point))) + 26 32 (/ height 32) material) (draw-short-rendered-icon-flomap - 26 32 (λ (dc) - (send dc set-pen (icon-color->outline-color arm-color) - (+ arm-width (* 2 line-width)) 'solid) - (send dc draw-lines (list standing-left-shoulder-point - standing-left-elbow-point - standing-left-hand-point)) - (send dc set-pen arm-color arm-width 'solid) - (send dc draw-lines (list standing-left-shoulder-point - standing-left-elbow-point - standing-left-hand-point))) - (/ height 32) - material) + (λ (dc) + (send dc set-pen (icon-color->outline-color arm-color) + (+ arm-width (* 2 line-width)) 'solid) + (send dc draw-lines (list standing-left-shoulder-point + standing-left-elbow-point + standing-left-hand-point)) + (send dc set-pen arm-color arm-width 'solid) + (send dc draw-lines (list standing-left-shoulder-point + standing-left-elbow-point + standing-left-hand-point))) + 26 32 (/ height 32) material) (draw-short-rendered-icon-flomap - 26 32 (λ (dc) - (send dc set-pen (icon-color->outline-color head-color) line-width 'solid) - (send dc set-brush head-color 'solid) - (match-define (cons x y) standing-head-point) - (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) - (/ height 32) - material)))) + (λ (dc) + (send dc set-pen (icon-color->outline-color head-color) line-width 'solid) + (send dc set-brush head-color 'solid) + (match-define (cons x y) standing-head-point) + (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) + 26 32 (/ height 32) material)))) ;; =================================================================================================== ;; Running @@ -269,37 +265,34 @@ (make-cached-flomap [height t color material] (draw-rendered-icon-flomap - 26 32 (λ (dc) - (send dc set-pen (icon-color->outline-color color) line-width 'solid) - (send dc set-brush color 'solid) - (match-define (cons x y) (running-head-point t)) - (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) - (/ height 32) - material))) + (λ (dc) + (send dc set-pen (icon-color->outline-color color) line-width 'solid) + (send dc set-brush color 'solid) + (match-define (cons x y) (running-head-point t)) + (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) + 26 32 (/ height 32) material))) (define (running-leg-flomap t body? color height material) (make-cached-flomap [height t body? color material] (draw-rendered-icon-flomap - 26 32 (λ (dc) - (draw-running-leg dc t (icon-color->outline-color color) (+ leg-width (* 2 line-width))) - (when body? - (draw-running-body dc t (icon-color->outline-color color) - (+ body-width (* 2 line-width))) - (draw-running-body dc t color body-width)) - (draw-running-leg dc t color leg-width)) - (/ height 32) - material))) + (λ (dc) + (draw-running-leg dc t (icon-color->outline-color color) (+ leg-width (* 2 line-width))) + (when body? + (draw-running-body dc t (icon-color->outline-color color) + (+ body-width (* 2 line-width))) + (draw-running-body dc t color body-width)) + (draw-running-leg dc t color leg-width)) + 26 32 (/ height 32) material))) (define (running-arm-flomap t color height material) (make-cached-flomap [height t color material] (draw-rendered-icon-flomap - 26 32 (λ (dc) - (draw-running-arm dc t (icon-color->outline-color color) (+ arm-width (* 2 line-width))) - (draw-running-arm dc t color arm-width)) - (/ height 32) - material))) + (λ (dc) + (draw-running-arm dc t (icon-color->outline-color color) (+ arm-width (* 2 line-width))) + (draw-running-arm dc t color arm-width)) + 26 32 (/ height 32) material))) (defproc (running-stickman-flomap [t rational?] [color (or/c string? (is-a?/c color%))] diff --git a/collects/images/icons/style.rkt b/collects/images/icons/style.rkt index cbacf5bb6b..53e222439f 100644 --- a/collects/images/icons/style.rkt +++ b/collects/images/icons/style.rkt @@ -123,21 +123,21 @@ [dfm (deep-flomap-raise dfm (* s height))]) dfm)) -(define (draw-icon-flomap w h draw-proc scale) - (draw-flomap (inexact->exact (ceiling (* w scale))) - (inexact->exact (ceiling (* h scale))) - (λ (dc) +(define (draw-icon-flomap draw-proc w h scale) + (draw-flomap (λ (dc) (send dc set-scale scale scale) (send dc set-smoothing 'smoothed) (send dc set-origin (* 0.5 scale) (* 0.5 scale)) (set-icon-pen dc "black" 10 'solid) - (draw-proc dc)))) + (draw-proc dc)) + (inexact->exact (ceiling (* w scale))) + (inexact->exact (ceiling (* h scale))))) (define (flomap-render-icon fm material) (deep-flomap-render-icon (deep-flomap-icon-style (flomap->deep-flomap fm)) material)) -(define (draw-rendered-icon-flomap w h draw-proc scale material) - (let* ([fm (draw-icon-flomap w h draw-proc scale)] +(define (draw-rendered-icon-flomap draw-proc w h scale material) + (let* ([fm (draw-icon-flomap draw-proc w h scale)] [fm (flomap-render-icon fm material)]) fm)) @@ -149,8 +149,8 @@ dfm)) (deep-flomap-render-icon dfm material)) -(define (draw-short-rendered-icon-flomap w h proc scale material) - (flomap-render-thin-icon (draw-icon-flomap w h proc scale) material)) +(define (draw-short-rendered-icon-flomap draw-proc w h scale material) + (flomap-render-thin-icon (draw-icon-flomap draw-proc w h scale) material)) ;; =================================================================================================== ;; Syntax for writing icon functions diff --git a/collects/images/icons/symbol.rkt b/collects/images/icons/symbol.rkt index cfde68106a..c3e26c4f4d 100644 --- a/collects/images/icons/symbol.rkt +++ b/collects/images/icons/symbol.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/draw racket/class racket/math racket/sequence +(require racket/draw racket/class racket/math racket/sequence racket/flonum racket/contract unstable/latent-contract unstable/latent-contract/defthing "../private/flomap.rkt" "../private/deep-flomap.rkt" @@ -21,28 +21,28 @@ (define mn 7.5) (define mx 23.5) (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen (make-object pen% (icon-color->outline-color color) - 12 'solid 'projecting 'miter)) - (send dc draw-line mn mn mx mx) - (send dc draw-line mn mx mx mn) - (send dc set-pen (make-object pen% color 10 'solid 'projecting 'miter)) - (send dc draw-line mn mn mx mx) - (send dc draw-line mn mx mx mn)) - (/ height 32))) + (λ (dc) + (send dc set-pen (make-object pen% (icon-color->outline-color color) + 12 'solid 'projecting 'miter)) + (send dc draw-line mn mn mx mx) + (send dc draw-line mn mx mx mn) + (send dc set-pen (make-object pen% color 10 'solid 'projecting 'miter)) + (send dc draw-line mn mn mx mx) + (send dc draw-line mn mx mx mn)) + 32 32 (/ height 32))) (define (flat-check-flomap color height) (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc '((m 0 19) - (c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23) - (l -9 -8) - (c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5) - (l -6 9)) - 0 0)) - (/ height 32))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc '((m 0 19) + (c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23) + (l -9 -8) + (c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5) + (l -6 9)) + 0 0)) + 32 32 (/ height 32))) (defproc (text-flomap [str string?] [font (is-a?/c font%)] [color (or/c string? (is-a?/c color%))] @@ -68,14 +68,15 @@ (define-values (w h) (get-text-size str font)) (define ceiling-amt (inexact->exact (ceiling outline))) (let* ([fm (draw-flomap - w h (λ (dc) + (λ (dc) (send dc set-font font) (send dc set-text-foreground color) - (send dc draw-text str 0 0 #t)))] + (send dc draw-text str 0 0 #t)) + w h)] [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 (list r g b)) fm)]) + [fm (if (outline . > . 0) (flomap-outlined fm outline (flvector r g b)) fm)]) (flomap-render-icon fm material))))) (define recycle-path-commands @@ -135,12 +136,11 @@ (make-cached-flomap [height color material] (draw-short-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 1/2 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc recycle-path-commands 0 0)) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 1/2 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc recycle-path-commands 0 0)) + 32 32 (/ height 32) material))) (defproc (x-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] @@ -229,15 +229,14 @@ (make-cached-flomap [height color material] (draw-rendered-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc (icon-color->outline-color color) 4 'solid) - (send dc set-brush (icon-color->outline-color color) 'solid) - (draw-path-commands dc lambda-path-commands 4 0) - (set-icon-pen dc color 2 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc lambda-path-commands 4 0)) - (/ height 32) - material))) + (λ (dc) + (set-icon-pen dc (icon-color->outline-color color) 4 'solid) + (send dc set-brush (icon-color->outline-color color) 'solid) + (draw-path-commands dc lambda-path-commands 4 0) + (set-icon-pen dc color 2 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc lambda-path-commands 4 0)) + 32 32 (/ height 32) material))) (defproc (hash-quote-flomap [color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] @@ -257,16 +256,15 @@ (define outline-color (icon-color->outline-color color)) (draw-rendered-icon-flomap - 36 32 (λ (dc) - (send dc translate 0.5 0.5) - (set-icon-pen dc outline-color 2 'solid) - (send dc set-brush outline-color 'solid) - (draw-hash-quote dc) - (send dc set-pen "black" 1 'transparent) - (send dc set-brush color 'solid) - (draw-hash-quote dc)) - (/ height 32) - material))) + (λ (dc) + (send dc translate 0.5 0.5) + (set-icon-pen dc outline-color 2 'solid) + (send dc set-brush outline-color 'solid) + (draw-hash-quote dc) + (send dc set-pen "black" 1 'transparent) + (send dc set-brush color 'solid) + (draw-hash-quote dc)) + 36 32 (/ height 32) material))) ;; =================================================================================================== ;; Bitmaps (icons) diff --git a/collects/images/logos.rkt b/collects/images/logos.rkt index 4febd1ca0c..844cee1e12 100644 --- a/collects/images/logos.rkt +++ b/collects/images/logos.rkt @@ -116,26 +116,26 @@ (define scale (/ height 256)) (define bulge-fm (draw-icon-flomap - 256 256 (λ (dc) - (send dc set-pen logo-red-color 2 'transparent) - (send dc set-brush logo-red-color 'solid) - (send dc draw-path (make-arc-path 8 8 239 239 blue-θ-end blue-θ-start)) - (send dc set-pen logo-blue-color 2 'transparent) - (send dc set-brush logo-blue-color 'solid) - (send dc draw-path (make-arc-path 8 8 239 239 blue-θ-start blue-θ-end)) - (send dc set-pen (lambda-pen lambda-outline-color 10)) - (send dc set-brush lambda-outline-color 'solid) - (draw-lambda dc 8 8 240 240)) - scale)) + (λ (dc) + (send dc set-pen logo-red-color 2 'transparent) + (send dc set-brush logo-red-color 'solid) + (send dc draw-path (make-arc-path 8 8 239 239 blue-θ-end blue-θ-start)) + (send dc set-pen logo-blue-color 2 'transparent) + (send dc set-brush logo-blue-color 'solid) + (send dc draw-path (make-arc-path 8 8 239 239 blue-θ-start blue-θ-end)) + (send dc set-pen (lambda-pen lambda-outline-color 10)) + (send dc set-brush lambda-outline-color 'solid) + (draw-lambda dc 8 8 240 240)) + 256 256 scale)) (define (lambda-flomap color pen-width) (draw-icon-flomap - 256 256 (λ (dc) - (send dc set-scale scale scale) - (send dc set-pen (lambda-pen color pen-width)) - (send dc set-brush color 'solid) - (draw-lambda dc 8 8 240 240)) - scale)) + (λ (dc) + (send dc set-scale scale scale) + (send dc set-pen (lambda-pen color pen-width)) + (send dc set-brush color 'solid) + (draw-lambda dc 8 8 240 240)) + 256 256 scale)) (let* ([bulge-dfm (flomap->deep-flomap bulge-fm)] [bulge-dfm (deep-flomap-bulge-spheroid bulge-dfm (* 112 scale))] @@ -150,14 +150,14 @@ lambda-fm)] [fm (flomap-cc-superimpose (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen lambda-outline-color 1/2 'solid) - (send dc set-brush "white" 'solid) - (send dc draw-ellipse -0.25 -0.25 31.5 31.5) - (send dc set-pen "lightblue" 1/2 'solid) - (send dc set-brush "white" 'transparent) - (send dc draw-ellipse 0.5 0.5 30 30)) - (/ height 32)) + (λ (dc) + (send dc set-pen lambda-outline-color 1/2 'solid) + (send dc set-brush "white" 'solid) + (send dc draw-ellipse -0.25 -0.25 31.5 31.5) + (send dc set-pen "lightblue" 1/2 'solid) + (send dc set-brush "white" 'transparent) + (send dc draw-ellipse 0.5 0.5 30 30)) + 32 32 (/ height 32)) fm)]) fm))) @@ -252,11 +252,11 @@ (define (continents-flomap color height) (define scale (/ height 32)) (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen lambda-outline-color 3/8 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc continents-path-commands 0 -17)) - scale)) + (λ (dc) + (send dc set-pen lambda-outline-color 3/8 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc continents-path-commands 0 -17)) + 32 32 scale)) (defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap? (make-cached-flomap @@ -268,11 +268,11 @@ [indent-dfm (deep-flomap-raise indent-dfm (* -1/8 scale))] [indent-dfm (deep-flomap-smooth-z indent-dfm (* 1 scale))] [earth-fm (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen logo-water-color 1/2 'solid) - (send dc set-brush logo-water-color 'solid) - (send dc draw-ellipse 0.75 0.75 29.5 29.5)) - scale)] + (λ (dc) + (send dc set-pen logo-water-color 1/2 'solid) + (send dc set-brush logo-water-color 'solid) + (send dc draw-ellipse 0.75 0.75 29.5 29.5)) + 32 32 scale)] [earth-dfm (flomap->deep-flomap earth-fm)] [earth-dfm (deep-flomap-bulge-spheroid earth-dfm (* 16 scale))] [earth-dfm (deep-flomap-cc-superimpose 'add earth-dfm indent-dfm)]) @@ -288,14 +288,14 @@ (flomap-cc-superimpose (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen lambda-outline-color 1/2 'solid) - (send dc set-brush "white" 'solid) - (send dc draw-ellipse -0.25 -0.25 31.5 31.5) - (send dc set-pen "lightblue" 1/2 'solid) - (send dc set-brush "white" 'transparent) - (send dc draw-ellipse 0.5 0.5 30 30)) - scale) + (λ (dc) + (send dc set-pen lambda-outline-color 1/2 'solid) + (send dc set-brush "white" 'solid) + (send dc draw-ellipse -0.25 -0.25 31.5 31.5) + (send dc set-pen "lightblue" 1/2 'solid) + (send dc set-brush "white" 'transparent) + (send dc draw-ellipse 0.5 0.5 30 30)) + 32 32 scale) earth-fm land-fm))) @@ -338,11 +338,11 @@ (define (racket-r-flomap color height) (draw-icon-flomap - 32 32 (λ (dc) - (set-icon-pen dc racket-r-outline-color 3/8 'solid) - (send dc set-brush color 'solid) - (draw-path-commands dc racket-r-commands 0 0)) - (/ height 32))) + (λ (dc) + (set-icon-pen dc racket-r-outline-color 3/8 'solid) + (send dc set-brush color 'solid) + (draw-path-commands dc racket-r-commands 0 0)) + 32 32 (/ height 32))) (define racket-sphere-material (deep-flomap-material-value @@ -361,20 +361,20 @@ [indent-dfm (deep-flomap-raise indent-dfm (* -0.75 scale))] [indent-dfm (deep-flomap-smooth-z indent-dfm (* 0.5 scale))] [sphere-fm (draw-icon-flomap - 32 32 (λ (dc) - (define top-rgn (make-object region% dc)) - (send top-rgn set-polygon - '((0 . 0) (31 . 0) (31 . 4) (5 . 13) (8 . 31) (0 . 31))) - - (send dc set-pen logo-blue-color 1/2 'solid) - (send dc set-brush logo-blue-color 'solid) - (send dc draw-ellipse 0.75 0.75 29.5 29.5) - - (send dc set-clipping-region top-rgn) - (send dc set-pen logo-red-color 1/2 'solid) - (send dc set-brush logo-red-color 'solid) - (send dc draw-ellipse 0.75 0.75 29.5 29.5)) - scale)] + (λ (dc) + (define top-rgn (make-object region% dc)) + (send top-rgn set-polygon + '((0 . 0) (31 . 0) (31 . 4) (5 . 13) (8 . 31) (0 . 31))) + + (send dc set-pen logo-blue-color 1/2 'solid) + (send dc set-brush logo-blue-color 'solid) + (send dc draw-ellipse 0.75 0.75 29.5 29.5) + + (send dc set-clipping-region top-rgn) + (send dc set-pen logo-red-color 1/2 'solid) + (send dc set-brush logo-red-color 'solid) + (send dc draw-ellipse 0.75 0.75 29.5 29.5)) + 32 32 scale)] [sphere-dfm (flomap->deep-flomap sphere-fm)] [sphere-dfm (deep-flomap-bulge-spheroid sphere-dfm (* 14 scale))] [sphere-dfm (deep-flomap-cc-superimpose 'add sphere-dfm indent-dfm)]) @@ -389,14 +389,14 @@ (flomap-cc-superimpose (draw-icon-flomap - 32 32 (λ (dc) - (send dc set-pen racket-r-outline-color 1/2 'solid) - (send dc set-brush "white" 'solid) - (send dc draw-ellipse -0.25 -0.25 31.5 31.5) - (send dc set-pen "lightblue" 1/2 'solid) - (send dc set-brush "white" 'transparent) - (send dc draw-ellipse 0.5 0.5 30 30)) - scale) + (λ (dc) + (send dc set-pen racket-r-outline-color 1/2 'solid) + (send dc set-brush "white" 'solid) + (send dc draw-ellipse -0.25 -0.25 31.5 31.5) + (send dc set-pen "lightblue" 1/2 'solid) + (send dc set-brush "white" 'transparent) + (send dc draw-ellipse 0.5 0.5 30 30)) + 32 32 scale) sphere-fm r-fm))) diff --git a/collects/images/private/draw-predicates.rkt b/collects/images/private/draw-predicates.rkt deleted file mode 100644 index b0a9c4a011..0000000000 --- a/collects/images/private/draw-predicates.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket/base - -(require racket/draw racket/class) - -(provide bitmap? dc?) - -(define (bitmap? bm) - (bm . is-a? . bitmap%)) - -(define (dc? dc) - (dc . is-a? . dc<%>)) diff --git a/collects/images/private/flomap-blur.rkt b/collects/images/private/flomap-blur.rkt index c47ffa22ad..a059c7aa03 100644 --- a/collects/images/private/flomap-blur.rkt +++ b/collects/images/private/flomap-blur.rkt @@ -21,11 +21,12 @@ (flomap-gaussian-blur-y (flomap-gaussian-blur-x fm (abs (exact->inexact xσ))) (abs (exact->inexact yσ)))])) -(: flomap-gaussian-blur-x (flomap Flonum -> flomap)) -(define (flomap-gaussian-blur-x fm σ) +(: flomap-gaussian-blur-x (flomap Real -> flomap)) +(define (flomap-gaussian-blur-x fm σ*) (cond - [(σ . = . 0.0) fm] + [(σ* . = . 0) fm] [else + (define σ (abs (exact->inexact σ*))) (define dx-min (fl->fx (floor (* (- 3.0) σ)))) (define dx-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ))))) (define ss (gaussian-kernel-1d dx-min dx-max σ)) @@ -44,11 +45,12 @@ (fx+ j c))] [else sum]))))])) -(: flomap-gaussian-blur-y (flomap Flonum -> flomap)) -(define (flomap-gaussian-blur-y fm σ) +(: flomap-gaussian-blur-y (flomap Real -> flomap)) +(define (flomap-gaussian-blur-y fm σ*) (cond - [(σ . = . 0.0) fm] + [(σ* . = . 0) fm] [else + (define σ (abs (exact->inexact σ*))) (define dy-min (fl->fx (floor (* (- 3.0) σ)))) (define dy-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ))))) (define ss (gaussian-kernel-1d dy-min dy-max σ)) @@ -203,8 +205,9 @@ [else (flomap-box-blur-y (flomap-box-blur-x fm xr) yr)]))])) -(: flomap-box-blur-x (flomap Flonum -> flomap)) -(define (flomap-box-blur-x fm r) +(: flomap-box-blur-x (flomap Real -> flomap)) +(define (flomap-box-blur-x fm r*) + (define r (abs (exact->inexact r*))) (cond [(integer? r) (let ([r (fl->fx r)]) (with-asserts ([r nonnegative-fixnum?]) @@ -229,8 +232,9 @@ (* norm2 (raw-flomap-integral-x-sum int-vs int-c int-w k (fx- x r2) (fx+ x r2+1) y)) )))])) -(: flomap-box-blur-y (flomap Flonum -> flomap)) -(define (flomap-box-blur-y fm r) +(: flomap-box-blur-y (flomap Real -> flomap)) +(define (flomap-box-blur-y fm r*) + (define r (abs (exact->inexact r*))) (cond [(integer? r) (let ([r (fl->fx r)]) (with-asserts ([r nonnegative-fixnum?]) diff --git a/collects/images/private/flomap-composite.rkt b/collects/images/private/flomap-composite.rkt index 17abfc23fb..2ce11687e4 100644 --- a/collects/images/private/flomap-composite.rkt +++ b/collects/images/private/flomap-composite.rkt @@ -1,6 +1,6 @@ #lang typed/racket/base -(require racket/match +(require racket/match racket/unsafe/ops "flonum.rkt" "flomap-struct.rkt") @@ -11,62 +11,99 @@ flomap-vl-append flomap-vc-append flomap-vr-append flomap-ht-append flomap-hc-append flomap-hb-append) -(: flomap-pin (flomap Real Real flomap Real Real -> flomap)) -(define (flomap-pin fm1 x1 y1 fm2 x2 y2) - (cond - [(not (and (zero? x2) (zero? y2))) - (flomap-pin fm1 (- x1 x2) (- y1 y2) fm2 0 0)] - [else - (let ([x1 (exact->inexact x1)] [y1 (exact->inexact y1)]) - (match-define (flomap argb1-vs 4 w1 h1) fm1) - (match-define (flomap argb2-vs 4 w2 h2) fm2) - - ;; fm1 and fm2 offsets, in final image coordinates - (define dx1 (fl->fx (round (max 0.0 (- x1))))) - (define dy1 (fl->fx (round (max 0.0 (- y1))))) - (define dx2 (fl->fx (round (max 0.0 x1)))) - (define dy2 (fl->fx (round (max 0.0 y1)))) - - ;; final image size - (define w (fxmax (fx+ dx1 w1) (fx+ dx2 w2))) - (define h (fxmax (fx+ dy1 h1) (fx+ dy2 h2))) - - (: get-argb-pixel (FlVector Integer Integer Integer Integer Integer Integer - -> (values Flonum Flonum Flonum Flonum))) - (define (get-argb-pixel argb-vs dx dy w h x y) - (let ([x (fx- x dx)] [y (fx- y dy)]) - (cond [(and (x . fx>= . 0) (x . fx< . w) (y . fx>= . 0) (y . fx< . h)) - (define i (coords->index 4 w 0 x y)) - (values (flvector-ref argb-vs i) - (flvector-ref argb-vs (fx+ i 1)) - (flvector-ref argb-vs (fx+ i 2)) - (flvector-ref argb-vs (fx+ i 3)))] - [else (values 0.0 0.0 0.0 0.0)]))) - - (define argb-vs (make-flvector (* 4 w h))) - (let: y-loop : Void ([y : Nonnegative-Fixnum 0]) - (when (y . fx< . h) - (let: x-loop : Void ([x : Nonnegative-Fixnum 0]) - (cond - [(x . fx< . w) - (define-values (a1 r1 g1 b1) (get-argb-pixel argb1-vs dx1 dy1 w1 h1 x y)) - (define-values (a2 r2 g2 b2) (get-argb-pixel argb2-vs dx2 dy2 w2 h2 x y)) - (define i (coords->index 4 w 0 x y)) - (flvector-set! argb-vs i (fl-alpha-blend a1 a2 a2)) - (flvector-set! argb-vs (fx+ i 1) (fl-alpha-blend r1 r2 a2)) - (flvector-set! argb-vs (fx+ i 2) (fl-alpha-blend g1 g2 a2)) - (flvector-set! argb-vs (fx+ i 3) (fl-alpha-blend b1 b2 a2)) - (x-loop (fx+ x 1))] - [else (y-loop (fx+ y 1))])))) - (flomap argb-vs 4 w h))])) +(: flomap-pin (case-> (flomap Integer Integer flomap -> flomap) + (flomap Integer Integer flomap Integer Integer -> flomap))) +(define flomap-pin + (case-lambda + [(fm1 x1 y1 fm2) + (match-define (flomap argb1-vs c w1 h1) fm1) + (match-define (flomap argb2-vs c2 w2 h2) fm2) + + (unless (c . > . 0) + (raise-type-error 'flomap-pin "flomap with at least one component" fm1)) + + (unless (= c c2) + (error 'flomap-pin + (string-append "expected two flomaps with the same number of components; " + "given one with ~e and one with ~e") + c c2)) + + ;; fm1 and fm2 offsets, in final image coordinates + (define dx1 (fxmax 0 (fx- 0 x1))) + (define dy1 (fxmax 0 (fx- 0 y1))) + (define dx2 (fxmax 0 x1)) + (define dy2 (fxmax 0 y1)) + + ;; final image size + (define w (fxmax (unsafe-fx+ dx1 w1) (unsafe-fx+ dx2 w2))) + (define h (fxmax (unsafe-fx+ dy1 h1) (unsafe-fx+ dy2 h2))) + + (define argb-vs (make-flvector (* c w h))) + (let: y-loop : Void ([y : Nonnegative-Fixnum 0]) + (when (y . fx< . h) + (define y1 (unsafe-fx- y dy1)) + (define y2 (unsafe-fx- y dy2)) + (let: x-loop : Void ([x : Nonnegative-Fixnum 0]) + (cond + [(x . fx< . w) + (define x1 (unsafe-fx- x dx1)) + (define x2 (unsafe-fx- x dx2)) + + (define i (coords->index c w 0 x y)) + (define-values (i1 a1) + (cond [(and (x1 . fx>= . 0) (x1 . fx< . w1) (y1 . fx>= . 0) (y1 . fx< . h1)) + (define i1 (coords->index c w1 0 x1 y1)) + (values i1 (flvector-ref argb1-vs i1))] + [else (values 0 0.0)])) + (define-values (i2 a2) + (cond [(and (x2 . fx>= . 0) (x2 . fx< . w2) (y2 . fx>= . 0) (y2 . fx< . h2)) + (define i2 (coords->index c w2 0 x2 y2)) + (values i2 (flvector-ref argb2-vs i2))] + [else (values 0 0.0)])) + + (cond + [(and (a1 . > . 0.0) (a2 . > . 0.0)) + (let: k-loop : Void ([k : Nonnegative-Fixnum 0]) + (cond [(k . fx< . c) (define v1 (flvector-ref argb1-vs (unsafe-fx+ i1 k))) + (define v2 (flvector-ref argb2-vs (unsafe-fx+ i2 k))) + (define v (fl-alpha-blend v1 v2 a2)) + (flvector-set! argb-vs (unsafe-fx+ i k) v) + (k-loop (unsafe-fx+ k 1))] + [else (x-loop (unsafe-fx+ x 1))]))] + [(a1 . > . 0.0) + (let: k-loop : Void ([k : Nonnegative-Fixnum 0]) + (cond [(k . fx< . c) (define v1 (flvector-ref argb1-vs (unsafe-fx+ i1 k))) + (flvector-set! argb-vs (unsafe-fx+ i k) v1) + (k-loop (unsafe-fx+ k 1))] + [else (x-loop (unsafe-fx+ x 1))]))] + [(a2 . > . 0.0) + (let: k-loop : Void ([k : Nonnegative-Fixnum 0]) + (cond [(k . fx< . c) (define v2 (flvector-ref argb2-vs (unsafe-fx+ i2 k))) + (flvector-set! argb-vs (unsafe-fx+ i k) v2) + (k-loop (unsafe-fx+ k 1))] + [else (x-loop (unsafe-fx+ x 1))]))] + [else (x-loop (unsafe-fx+ x 1))])] + [else (y-loop (unsafe-fx+ y 1))])))) + (flomap argb-vs c w h)] + [(fm1 x1 y1 fm2 x2 y2) (flomap-pin fm1 (- x1 x2) (- y1 y2) fm2)])) (: flomap-pin* (Real Real Real Real flomap flomap * -> flomap)) -(define (flomap-pin* x1-frac y1-frac x2-frac y2-frac fm . fms) - (for/fold ([fm1 fm]) ([fm2 (in-list fms)]) - (define-values (w1 h1) (flomap-size fm1)) - (define-values (w2 h2) (flomap-size fm2)) - (flomap-pin fm1 (* x1-frac w1) (* y1-frac h1) - fm2 (* x2-frac w2) (* y2-frac h2)))) +(define (flomap-pin* x1-frac y1-frac x2-frac y2-frac fm0 . fms) + (define-values (fm _x _y) + (for/fold: ([fm : flomap fm0] + [x : Exact-Rational 0] + [y : Exact-Rational 0] + ) ([fm1 : flomap (in-list (cons fm0 fms))] + [fm2 : flomap (in-list fms)]) + (define-values (w1 h1) (flomap-size fm1)) + (define-values (w2 h2) (flomap-size fm2)) + (define x1 (+ x (- (inexact->exact (* x1-frac w1)) + (inexact->exact (* x2-frac w2))))) + (define y1 (+ y (- (inexact->exact (* y1-frac h1)) + (inexact->exact (* y2-frac h2))))) + (values (flomap-pin fm (round x1) (round y1) fm2) + (max 0 x1) (max 0 y1)))) + fm) (: flomap-lt-superimpose (flomap flomap * -> flomap)) (: flomap-lc-superimpose (flomap flomap * -> flomap)) diff --git a/collects/images/private/flomap-convert.rkt b/collects/images/private/flomap-convert.rkt index 8343c5a44f..769c6134d2 100644 --- a/collects/images/private/flomap-convert.rkt +++ b/collects/images/private/flomap-convert.rkt @@ -15,6 +15,8 @@ [else 0.0]))) (define (bitmap->flomap bm) + (unless (is-a? bm bitmap%) + (raise-type-error 'bitmap->flomap "bitmap% instance" bm)) (define w (send bm get-width)) (define h (send bm get-height)) (define bs (make-bytes (* 4 w h))) @@ -72,7 +74,7 @@ (send bm set-argb-pixels 0 0 w h bs #f #t) bm)) -(define (draw-flomap w h draw-proc) +(define (draw-flomap draw-proc w h) (unless (w . >= . 0) (raise-type-error 'draw-flomap "nonnegative fixnum" 0 w h draw-proc)) (unless (h . >= . 0) (raise-type-error 'draw-flomap "nonnegative fixnum" 1 w h draw-proc)) diff --git a/collects/images/private/flomap-effects.rkt b/collects/images/private/flomap-effects.rkt index 064f1b8ffb..08df827257 100644 --- a/collects/images/private/flomap-effects.rkt +++ b/collects/images/private/flomap-effects.rkt @@ -13,13 +13,13 @@ flomap-shadow flomap-shadowed flomap-whirl-morph) -(: colorize-alpha (flomap (Listof Real) -> flomap)) -(define (colorize-alpha fm color) +(: colorize-alpha (flomap FlVector -> flomap)) +(define (colorize-alpha fm vs) (match-define (flomap _ 1 w h) fm) - (flomap-append-components fm (fm* fm (make-flomap/components w h color)))) + (flomap-append-components fm (fm* fm (make-flomap* w h vs)))) (: flomap-shadow (case-> (flomap Real -> flomap) - (flomap Real (Option (Listof Real)) -> flomap))) + (flomap Real (Option FlVector) -> flomap))) (define flomap-shadow (case-lambda [(fm σ) (flomap-shadow fm σ #f)] @@ -27,18 +27,18 @@ (match-define (flomap _ c w h) fm) (cond [(c . = . 0) fm] [else (define alpha-fm (flomap-ref-component fm 0)) - (define color-vs (if (list? color) color (make-list (- c 1) 0.0))) + (define color-vs (if (flvector? 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 (Listof Real)) -> flomap))) + (flomap Real (Option FlVector) -> flomap))) (define flomap-shadowed (case-lambda [(fm σ) (flomap-shadowed fm σ #f)] [(fm σ c) (flomap-cc-superimpose (flomap-shadow fm σ c) fm)])) (: flomap-outline (case-> (flomap Real -> flomap) - (flomap Real (Option (Listof Real)) -> flomap))) + (flomap Real (Option FlVector) -> flomap))) (define flomap-outline (case-lambda [(fm amt) (flomap-outline fm amt #f)] @@ -57,11 +57,11 @@ (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 (list? color) color (make-list (- c 1) 0.0))) + (define color-vs (if (flvector? color) color (make-flvector (- c 1) 0.0))) (colorize-alpha new-alpha-fm color-vs))])) (: flomap-outlined (case-> (flomap Real -> flomap) - (flomap Real (Option (Listof Real)) -> flomap))) + (flomap Real (Option FlVector) -> flomap))) (define flomap-outlined (case-lambda [(fm amt) (flomap-outlined fm amt #f)] diff --git a/collects/images/private/flomap-gradient.rkt b/collects/images/private/flomap-gradient.rkt index af35183ef8..23ac7c4ea9 100644 --- a/collects/images/private/flomap-gradient.rkt +++ b/collects/images/private/flomap-gradient.rkt @@ -8,7 +8,7 @@ (provide flomap-gradient-x flomap-gradient-y flomap-gradient flomap-gradient-normal) ;; =================================================================================================== -;; Derivatives (Schurr operator) +;; Derivatives (Scharr operator) (: flomap-gradient-x (flomap -> flomap)) (define (flomap-gradient-x fm) @@ -70,6 +70,8 @@ (: flomap-gradient-normal (flomap -> flomap)) (define (flomap-gradient-normal z-fm) + (unless (= 1 (flomap-components z-fm)) + (raise-type-error 'flomap-gradient-normal "flomap with 1 component" z-fm)) (define-values (dx-fm dy-fm) (flomap-gradient z-fm)) (match-define (flomap dx-vs 1 w h) dx-fm) (match-define (flomap dy-vs 1 _w _h) dy-fm) diff --git a/collects/images/private/flomap-pointwise.rkt b/collects/images/private/flomap-pointwise.rkt index 94ccf06110..ff28ddb6f4 100644 --- a/collects/images/private/flomap-pointwise.rkt +++ b/collects/images/private/flomap-pointwise.rkt @@ -6,7 +6,7 @@ "flomap-stats.rkt") (provide flomap-lift flomap-lift2 inline-flomap-lift inline-flomap-lift2 - fmsqrt fm+ fm- fm* fm/ fmmin fmmax + fmsqrt fm+ fm- fm* fm/ fmmin fmmax fmsqr flomap-normalize flomap-multiply-alpha flomap-divide-alpha) ;; =================================================================================================== @@ -90,6 +90,9 @@ (define fmmin (inline-flomap-lift2 'fmmin min)) (define fmmax (inline-flomap-lift2 'fmmax max)) +(: fmsqr (flomap -> flomap)) +(define (fmsqr fm) (fm* fm fm)) + (: flomap-normalize (flomap -> flomap)) (define (flomap-normalize fm) (define-values (v-min v-max) (flomap-extreme-values fm)) diff --git a/collects/images/private/flomap-resize.rkt b/collects/images/private/flomap-resize.rkt index a664fed5c4..6ca3cd411c 100644 --- a/collects/images/private/flomap-resize.rkt +++ b/collects/images/private/flomap-resize.rkt @@ -7,12 +7,56 @@ "flomap-stats.rkt" "flomap-blur.rkt") -(provide flomap-inset flomap-trim flomap-crop +(provide flomap-copy subflomap flomap-trim flomap-inset flomap-crop flomap-lt-crop flomap-lc-crop flomap-lb-crop flomap-ct-crop flomap-cc-crop flomap-cb-crop flomap-rt-crop flomap-rc-crop flomap-rb-crop flomap-scale flomap-resize) +(: flomap-copy (flomap Integer Integer Integer Integer -> flomap)) +(define (flomap-copy fm x-start y-start x-end y-end) + (match-define (flomap src-vs c src-w src-h) fm) + (define dst-w (max 0 (- x-end x-start))) + (define dst-h (max 0 (- y-end y-start))) + (define new-fm (make-flomap c dst-w dst-h)) + (define dst-vs (flomap-values new-fm)) + (when (and (dst-w . > . 0) (dst-h . > . 0)) + (let: y-loop : Void ([dst-y : Nonnegative-Fixnum 0]) + (when (dst-y . fx< . dst-h) + (define src-y (fx+ dst-y y-start)) + (when (and (src-y . fx>= . 0) (src-y . fx< . src-h)) + (let: x-loop : Void ([dst-x : Nonnegative-Fixnum 0]) + (when (dst-x . fx< . dst-w) + (define src-x (fx+ dst-x x-start)) + (when (and (src-x . fx>= . 0) (src-x . fx< . src-w)) + (let: k-loop : Void ([k : Nonnegative-Fixnum 0]) + (when (k . fx< . c) + (define src-i (coords->index c src-w k src-x src-y)) + (define dst-i (coords->index c dst-w k dst-x dst-y)) + (flvector-set! dst-vs dst-i (flvector-ref src-vs src-i)) + (k-loop (unsafe-fx+ k 1))))) + (x-loop (unsafe-fx+ dst-x 1))))) + (y-loop (unsafe-fx+ dst-y 1))))) + new-fm) + +(: subflomap (flomap Integer Integer Integer Integer -> flomap)) +(define (subflomap fm x-start y-start x-end y-end) + (match-define (flomap _ _ src-w src-h) fm) + (cond [(and (= x-start 0) (= y-start 0) (= x-end src-w) (= y-end src-h)) fm] + [else (flomap-copy fm x-start y-start x-end y-end)])) + +(: flomap-trim (case-> (flomap -> flomap) + (flomap Boolean -> flomap))) +(define flomap-trim + (case-lambda + [(fm) (flomap-trim fm #t)] + [(fm alpha?) + (cond [(= (flomap-components fm) 0) (make-flomap 0 0 0)] + [else + (define-values (x-start y-start x-end y-end) + (flomap-nonzero-rect (if alpha? (flomap-ref-component fm 0) fm))) + (subflomap fm x-start y-start x-end y-end)])])) + (: flomap-inset (case-> (flomap Integer -> flomap) (flomap Integer Integer -> flomap) (flomap Integer Integer Integer Integer -> flomap))) @@ -21,41 +65,8 @@ [(fm amt) (flomap-inset fm amt amt amt amt)] [(fm h-amt v-amt) (flomap-inset fm h-amt v-amt h-amt v-amt)] [(fm l-amt t-amt r-amt b-amt) - (cond [(and (= l-amt 0) (= t-amt 0) (= r-amt 0) (= b-amt 0)) fm] - [else - (match-define (flomap src-vs c src-w src-h) fm) - (define dst-w (fxmax 0 (fx+ src-w (fx+ l-amt r-amt)))) - (define dst-h (fxmax 0 (fx+ src-h (fx+ t-amt b-amt)))) - (define dst-vs (make-flvector (* c dst-w dst-h))) - (cond - [(or (dst-w . fx= . 0) (dst-h . fx= . 0)) - (flomap dst-vs c dst-w dst-h)] - [else - (let: y-loop : Void ([dst-y : Nonnegative-Fixnum 0]) - (when (dst-y . fx< . dst-h) - (define src-y (fx- dst-y t-amt)) - (when (and (src-y . fx>= . 0) (src-y . fx< . src-h)) - (let: x-loop : Void ([dst-x : Nonnegative-Fixnum 0]) - (when (dst-x . fx< . dst-w) - (define src-x (fx- dst-x l-amt)) - (when (and (src-x . fx>= . 0) (src-x . fx< . src-w)) - (let: k-loop : Void ([k : Nonnegative-Fixnum 0]) - (when (k . fx< . c) - (define src-i (coords->index c src-w k src-x src-y)) - (define dst-i (coords->index c dst-w k dst-x dst-y)) - (flvector-set! dst-vs dst-i (flvector-ref src-vs src-i)) - (k-loop (unsafe-fx+ k 1))))) - (x-loop (unsafe-fx+ dst-x 1))))) - (y-loop (unsafe-fx+ dst-y 1)))) - (flomap dst-vs c dst-w dst-h)])])])) - -(: flomap-trim (flomap -> flomap)) -(define (flomap-trim fm) - (match-define (flomap _ c w h) fm) - (cond [(c . = . 0) (make-flomap 0 0 0)] - [else (define-values (x-min y-min x-max y-max) - (flomap-nonzero-rect (flomap-ref-component fm 0))) - (flomap-inset fm (- x-min) (- y-min) (- x-max w) (- y-max h))])) + (match-define (flomap _ _ w h) fm) + (subflomap fm (- l-amt) (- t-amt) (+ w r-amt) (+ h b-amt))])) (: flomap-crop (flomap Integer Integer Real Real -> flomap)) (define (flomap-crop fm width height x-frac y-frac) @@ -128,14 +139,14 @@ (: flomap-scale-x (flomap Flonum -> flomap)) (define (flomap-scale-x fm scale) (match-define (flomap _ c w h) fm) - (cond [(= 0 scale) (make-flomap c 0 h)] + (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)) (define (flomap-scale-y fm scale) (match-define (flomap _ c w h) fm) - (cond [(= 0 scale) (make-flomap c w 0)] + (cond [(= 0.0 scale) (make-flomap c w 0)] [else (let ([scale (abs scale)]) (flomap-scale*-y fm scale (abs (fl->fx (ceiling (* (exact->inexact h) scale))))))])) diff --git a/collects/images/private/flomap-struct.rkt b/collects/images/private/flomap-struct.rkt index 8c8d0ed983..71161c213e 100644 --- a/collects/images/private/flomap-struct.rkt +++ b/collects/images/private/flomap-struct.rkt @@ -9,9 +9,9 @@ (provide flomap flomap? flomap-values flomap-components flomap-width flomap-height ;; Accessors - flomap-size flomap-ref flomap-bilinear-ref coords->index + flomap-size unsafe-flomap-ref flomap-ref flomap-bilinear-ref coords->index ;; Basic constructors - make-flomap make-flomap/components build-flomap inline-build-flomap + make-flomap make-flomap* build-flomap inline-build-flomap flomap-ref-component flomap-take-components flomap-drop-components flomap-append-components) (struct: flomap ([values : FlVector] [components : Integer] [width : Integer] [height : Integer]) @@ -120,11 +120,10 @@ (define (build-flomap components width height fun) (inline-build-flomap components width height (λ (k x y i) (exact->inexact (fun k x y i))))) -(: make-flomap/components (Integer Integer (Listof Real) -> flomap)) -(define (make-flomap/components w h vs) - (let ([vs (apply flvector (map exact->inexact vs))]) - (define c (flvector-length vs)) - (inline-build-flomap c w h (λ (k _x _y _i) (unsafe-flvector-ref vs k))))) +(: make-flomap* (Integer Integer FlVector -> flomap)) +(define (make-flomap* w h vs) + (define c (flvector-length vs)) + (inline-build-flomap c w h (λ (k _x _y _i) (unsafe-flvector-ref vs k)))) (: flomap-ref-component (flomap Integer -> flomap)) (define (flomap-ref-component fm k) diff --git a/collects/images/private/flomap.rkt b/collects/images/private/flomap.rkt index 122230a9e5..72809cb812 100644 --- a/collects/images/private/flomap.rkt +++ b/collects/images/private/flomap.rkt @@ -10,16 +10,11 @@ "flomap-composite.rkt" "flomap-resize.rkt") -(require/typed - "draw-predicates.rkt" - [opaque Bitmap bitmap?] - [opaque DC dc?]) - (require/typed "flomap-convert.rkt" - [bitmap->flomap (Bitmap -> flomap)] - [flomap->bitmap (flomap -> Bitmap)] - [draw-flomap (Integer Integer (DC -> Any) -> flomap)]) + [bitmap->flomap (Any -> flomap)] + [flomap->bitmap (flomap -> Any)] + [draw-flomap ((Any -> Any) Integer Integer -> flomap)]) (provide (all-from-out "flomap-struct.rkt" "flomap-stats.rkt" @@ -30,5 +25,4 @@ "flomap-blur.rkt" "flomap-composite.rkt" "flomap-resize.rkt") - Bitmap DC bitmap->flomap flomap->bitmap draw-flomap) diff --git a/collects/images/scribblings/flomap.scrbl b/collects/images/scribblings/flomap.scrbl new file mode 100644 index 0000000000..ad0c06f34d --- /dev/null +++ b/collects/images/scribblings/flomap.scrbl @@ -0,0 +1,817 @@ +#lang scribble/manual + +@(require scribble/eval + (for-label racket + images/flomap + racket/draw + racket/flonum + slideshow) + images/flomap + slideshow/pict) + +@(define flomap-eval (make-base-eval)) +@interaction-eval[#:eval flomap-eval (require racket racket/flonum images/flomap)] + +@title[#:tag "flomap:title" #:style 'toc]{Floating-Point Bitmaps} +@author{@(author+email "Neil Toronto" "neil.toronto@gmail.com")} + +@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. + +@bold{This is a Typed Racket module.} +Its exports can generally be used from untyped code with negligible performance loss over typed code. +Exceptions are documented @bold{in bold text}. +Most exceptions are macros used to inline floating-point operations. + +The following flomap @racket[fm] is used in various examples: +@interaction[#:eval flomap-eval + (define fm + (draw-flomap + (λ (bm-dc) + (send bm-dc set-alpha 0) + (send bm-dc set-background "black") + (send bm-dc clear) + (send bm-dc set-alpha 1/3) + (send bm-dc translate 2 2) + (send bm-dc set-pen "black" 4 'long-dash) + (send bm-dc set-brush "red" 'solid) + (send bm-dc draw-ellipse 0 0 192 192) + (send bm-dc set-brush "green" 'solid) + (send bm-dc draw-ellipse 64 0 192 192) + (send bm-dc set-brush "blue" 'solid) + (send bm-dc draw-ellipse 32 44 192 192)) + 260 240)) + (flomap->bitmap fm)] +It is typical to use @racket[flomap->bitmap] to visualize a flomap at the REPL. + +Contents: +@local-table-of-contents[] + + +@; =================================================================================================== + + +@section{Overview} + +@subsection{Motivation} + +There are three main reasons to use flomaps: +@(itemlist + @item{@bold{Precision.} + A point in a typical bitmap is represented by a few bytes, each of which can have one of 256 distinct values. + In contrast, a point in a flomap is represented by double-precision floating-point numbers, typically between @racket[0.0] and @racket[1.0] inclusive. + This range contains about 4.6 @italic{quintillion} (or 4.6×10@superscript{18}) distinct values. + While bytes are fine for many applications, their low precision becomes a problem when images are repeatedly operated on, or when their values are built by adding many small amounts---which are often rounded to zero. + } + @item{@bold{Range.} + A floating-point value can also represent about 4.6 quintillion distinct intensities above saturation (@racket[1.0]). + If distinguishing oversaturated values is important, flomaps have the range for it. + Further, floating-point images are (approximately) closed under pointwise arithmetic. + } + @item{@bold{Speed.} + The @racketmodname[images/flomap] module benefits greatly from Typed Racket's type-directed optimizations. + Even getting individual color values---interpolated between points, if desired---is fast. + } + ) +For these reasons, other parts of the @racket[images] library use flomaps internally, to represent and operate on +ARGB and RGB images, light maps, shadow maps, height maps, and normal maps. + +@subsection[#:tag "flomap:conceptual"]{Conceptual Model} + +A flomap is conceptually infinite in its width and height, but has nonzero values in a finite rectangle starting at coordinate @racket[0] @racket[0] +and extending to its width and height (exclusive). +A flomap is @bold{not} conceptually infinite in its components because there is no natural linear order on component coordinates, as the meaning of components depends on programmer intent. + +The following example creates a 10×10 bitmap with RGB components, and indexes its top-left red value and two values outside the finite, nonzero rectangle. +It also attempts to index component @racket[3], which doesn't exist. +Note that @racket[flomap-ref] accepts its coordinate arguments in a standard order: @racket[k] @racket[x] @racket[y] (with @racket[k] for @bold{k}omponent). +@interaction[#:eval flomap-eval + (define magenta-fm (make-flomap* 10 10 (flvector 1.0 0.0 1.0))) + (flomap->bitmap magenta-fm) + (flomap-ref magenta-fm 0 0 0) + (flomap-ref magenta-fm 0 -1 0) + (flomap-ref magenta-fm 0 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. + +@examples[#:eval flomap-eval + (flomap-bilinear-ref magenta-fm 0 0.5 0.5) + (flomap-bilinear-ref magenta-fm 0 0.25 0.25) + (flomap-bilinear-ref magenta-fm 0 0.0 0.0)] + +This conceptual model allows us to treat flomaps as if they were multi-valued functions on @racket[Real]×@racket[Real]. +For example, we might plot the red component of an icon: +@interaction[#:eval flomap-eval + (require images/icons/misc plot) + (define icon-fm (bomb-flomap "azure" "orange" 48)) + (flomap->bitmap icon-fm) + (define-values (icon-width icon-height) (flomap-size icon-fm)) + (plot3d-bitmap (contour-intervals3d + (λ (x y) (flomap-bilinear-ref icon-fm 1 x y)) + 0 icon-width 0 icon-height))] +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. + +@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. +The other components should be multiplied by their corresponding alpha value; +i.e. an RGB triple @racket[1.0] @racket[0.5] @racket[0.25] with opacity @racket[0.5] should be represented +by @racket[0.5] @racket[0.5] @racket[0.25] @racket[0.125]. + +@margin-note*{This representation generally goes by the unfortunate misnomer ``premultiplied alpha,'' which makes it seem as if the @italic{alpha} component is multiplied by something.} +We will refer to this representation as @italic{alpha-multiplied} because the color components are multiplied by the alpha component. +All alpha-aware functions consume alpha-multiplied flomaps and produce alpha-multiplied flomaps. + +There are many good reasons to use alpha-multiplied flomaps instead of non-alpha-multiplied flomaps. +Some are: +@(itemlist + @item{Compositing requires fewer operations per point.} + @item{Compositing is associative; i.e. @racket[(flomap-lt-superimpose fm1 (flomap-lt-superimpose fm2 fm3))] + is the same as @racket[(flomap-lt-superimpose (flomap-lt-superimpose fm1 fm2) fm3)], up to floating-point error.} + @item{There is only one transparent point: all zeros. + We could not conceptualize partially transparent flomaps as being infinite in size without a unique transparent point.} + @item{Many functions can operate on flomaps without treating the alpha component specially and still be correct.} + ) + +As an example of the last point, consider blur. +The following example creates an alpha-multiplied flomap using @racket[draw-flomap]. +It blurs the flomap using a general-purpose (i.e. non-alpha-aware) blur function, then converts the flomap to non-alpha-multiplied and does the same. +@interaction[#:eval flomap-eval + (define circle-fm (draw-flomap (λ (dc) + (send dc set-pen "black" 1 'transparent) + (send dc set-brush "green" 'solid) + (send dc draw-ellipse 10 10 30 30)) + 50 50)) + (flomap->bitmap circle-fm) + (flomap->bitmap (flomap-blur circle-fm 4 4)) + (let* ([fm (flomap-divide-alpha circle-fm)] + [fm (flomap-blur fm 4 4)] + [fm (flomap-multiply-alpha fm)]) + (flomap->bitmap fm))] +Notice the dark band around the second blurred circle. + +Of course, this could be fixed by making @racket[flomap-blur] operate differently on flomaps with an alpha component. +But the implementation would amount to converting them to alpha-multiplied flomaps anyway. + +The only valid reason to not multiply color components by alpha is loss of precision, which is not an issue with flomaps. + +@subsection[#:tag "flomap:layout"]{Data Layout} + +For most applications, there should be enough flomap functions available that you should not need to access their fields directly. +However, there will always be use cases for direct manipulation, so the fields are public. + +@(define (color-square n col [size 30]) + (lt-superimpose (colorize (filled-rectangle size size) col) + (colorize (rectangle size size) "black") + (colorize (inset (text (number->string n) '(bold)) 2 1) "white"))) + +@(define (rgb-squares n) + (panorama + (pin-over (color-square n "red") + 10 10 (pin-over (color-square (+ n 1) "green") + 10 10 (color-square (+ n 2) "blue"))))) + +@(define (rgb-square n) + (cc-superimpose (colorize (filled-rectangle 60 60) "white") + (colorize (rectangle 60 60) "black") + (rgb-squares n))) + +@(define (row n) + (cc-superimpose (colorize (filled-rectangle 135 70) "lightgray") + (colorize (rectangle 135 70) "black") + (ht-append (rgb-square n) (blank 5) (rgb-square (+ n 3))))) + +@(define (rgb-rect n) + (ht-append (color-square n "red") + (color-square (+ n 1) "green") + (color-square (+ n 2) "blue"))) + +The color values in a flomap are stored flattened in a single @racket[FlVector], in row-major order with adjacent color components. +For example, a 2×2 RGB flomap can be visualized as + +@(vl-append (row 0) (blank 5) (row 6)) + +In a flomap, it would be stored as + +@(ht-append (rgb-rect 0) (rgb-rect 3) (rgb-rect 6) (rgb-rect 9)) + +Mathematically, for a @racket[c]-component, @racket[w]-width flomap, the @racket[k]th color component at position @racket[x] @racket[y] is at index +@racketblock[(+ k (* c (+ x (* y w))))] +The @racket[coords->index] function carries out this calculation quickly using only fixnum arithmetic. + +If @racket[i] is a calculated index for the value at @racket[k] @racket[x] @racket[y], +then the @racket[(+ k 1)]th value is at index @racket[(+ i 1)], +the @racket[(+ x 1)]th value is at index @racket[(+ i c)], +and the @racket[(+ y 1)]th value is at index @racket[(+ i (* c w))]. + + +@; =================================================================================================== + + +@section{Struct Type and Accessors} + +@defstruct*[flomap ([values FlVector] [components Integer] [width Integer] [height Integer])]{ +Represents a @racket[width]×@racket[height] floating-point bitmap with @racket[components] color components. +The @racketid[values] vector contains the flattened image data (see @secref{flomap:layout}). + +A guard ensures that the @racketid[values] field has length @racket[(* components width height)], +and that each size field is a nonnegative fixnum. + +@examples[#:eval flomap-eval + (require racket/flonum) + (flomap (flvector 0.0 0.0 0.0 0.0) 4 1 1) + (flomap (flvector) 0 0 0) + (flomap (flvector 0.0) 2 1 1)] + +The default @racket[flomap] constructor is perhaps the hardest to use. +Instead, to construct a @racket[flomap] from scratch, you should generally use @racket[make-flomap], @racket[make-flomap*], @racket[build-flomap] or @racket[draw-flomap]. +} + +@defproc[(flomap-size [fm flomap]) (values Nonnegative-Fixnum Nonnegative-Fixnum)]{ +Returns the width and height of @racket[fm] as nonnegative fixnums. +} + +@defproc[(flomap-ref [fm flomap] [k Integer] [x Integer] [y Integer]) Float]{ +Returns @racket[fm]'s value at @racket[k] @racket[x] @racket[y]. + +If @racket[x] or @racket[y] is out of bounds, this function returns @racket[0.0]. +If @racket[k] is out of bounds, it raises an error. +See @secref{flomap:conceptual} to read about why. +} + +@defproc[(flomap-bilinear-ref [fm flomap] [k Integer] [x Real] [y Real]) Float]{ +Returns an estimated value at any given @racket[k] @racket[x] @racket[y] coordinate, calculated from known values in @racket[fm]. + +Like all other @racket[flomap] functions that operate on real-valued coordinates, @racket[flomap-bilinear-ref] regards known values as being at half-integer coordinates. +Mathematically, if @racket[x] = @racket[(+ i 0.5)] and @racket[y] = @racket[(+ j 0.5)] for any integers @racket[i] and @racket[j], +then @racket[(flomap-bilinear-ref fm k x y)] = @racket[(flomap-ref fm k i j)]. + +If @racket[x] or @racket[y] is out of bounds, this function returns @racket[0.0]. +If @racket[k] is out of bounds, it raises an error. +See @secref{flomap:conceptual} to read about why. +} + +@defproc[(flomap-min-value [fm flomap]) Float] +@defproc[(flomap-max-value [fm flomap]) Float]{ +These return the minimum and maximum values in @racket[fm]. +} + +@defproc[(flomap-extreme-values [fm flomap]) (values Float Float)]{ +Equivalent to @racket[(values (flomap-min-value fm) (flomap-max-value fm))], but faster. +} + +@defproc[(flomap-nonzero-rect [fm flomap]) (values Nonnegative-Fixnum Nonnegative-Fixnum + Nonnegative-Fixnum Nonnegative-Fixnum)]{ +Returns the smallest rectangle containing every nonzero value (in any component) in @racket[fm]. +The values returned are @italic{x} minimum, @italic{y} minimum, @italic{x} maximum + 1, and @italic{y} maximum + 1. + +The values returned by @racket[flomap-nonzero-rect] can be sent to @racket[subflomap] to trim away zero values. +But see @racket[flomap-trim], which is faster for alpha-multiplied flomaps. +} + +@defproc[(coords->index [c Integer] [w Integer] [k Integer] [x Integer] [y Integer]) Fixnum]{ +Returns the index of the value at coordinates @racket[k] @racket[x] @racket[y] of a flomap with @racket[c] color components and width @racket[w]. +This function does not check any coordinates against their bounds. +} + +@defproc[(unsafe-flomap-ref [vs FlVector] + [c Integer] [w Integer] [h Integer] + [k Integer] [x Integer] [y Integer]) Float]{ +If @racket[fm] = @racket[(flomap vs c w h)], returns @racket[fm]'s value at @racket[k] @racket[x] @racket[y]. +If @racket[x] or @racket[y] is out of bounds, this returns @racket[0.0]. +It is unsafe because @racket[k] is unchecked, as well as indexing into @racket[vs]. + +This function is used by some library functions, such as @racket[flomap-bilinear-ref], to index into already-destructured flomaps. +From untyped code, applying this function is likely no faster than applying @racket[flomap-ref], because of extra contract checks. +} + + +@; =================================================================================================== + + +@section{Conversion and Construction} + +@defproc[(flomap->bitmap [fm flomap]) Any]{ +Converts a flomap to a @racket[bitmap%]. + +The return type is imprecise because Typed Racket does not support the object system well yet. +As a typed function, this is most useful in DrRacket's REPL to visualize flomaps; any other typed use is difficult. + +Flomaps are interpreted differently depending on the number of components: +@(itemlist + @item{@bold{Zero components.} Raises an error.} + @item{@bold{One component.} Interpreted as intensity (grayscale).} + @item{@bold{Two components.} Interpreted as AL, or alpha+intensity, with intensity multiplied by alpha.} + @item{@bold{Three components.} Interpreted as RGB.} + @item{@bold{Four components.} Interpreted as ARGB with color components multiplied by alpha.} + @item{@bold{More components.} Raises an error.} + ) +See @secref{flomap:opacity} for a discussion of opacity (alpha) representation. + +A zero-size @racket[fm] is padded by one point in any zero direction before conversion. +For example, if @racket[fm] is size 0×1, the result of @racket[(flomap->bitmap fm)] is size 1×1. +} + +@defproc[(bitmap->flomap [bm Any]) flomap]{ +Given a @racket[bitmap%] instance, returns an ARGB flomap with alpha-multiplied color components. +See @secref{flomap:opacity} for a discussion of opacity (alpha) representation. + +The argument type is imprecise because Typed Racket does not support the object system well yet. +} + +@defproc[(make-flomap [c Integer] [w Integer] [h Integer] [v Real 0.0]) flomap]{ +Returns a @racket[w]×@racket[h] flomap with @racket[c] components, with every value initialized to @racket[v]. + +To create flomaps filled with a solid color, use @racket[make-flomap*]. +} + +@defproc[(make-flomap* [w Integer] [h Integer] [vs FlVector]) flomap]{ +Returns a @racket[w]×@racket[h] flomap with @racket[(flvector-length vs)] color components, with each known point initialized using the values in @racket[vs]. + +The following two examples create magenta bitmaps with an alpha channel: +@interaction[#:eval flomap-eval + (flomap->bitmap (make-flomap* 100 100 (flvector 1.0 1.0 0.0 1.0))) + (flomap->bitmap (make-flomap* 100 100 (flvector 0.5 0.5 0.0 0.5)))] +See @secref{flomap:opacity} for a discussion of opacity (alpha) representation. +} + +@defproc[(build-flomap [c Integer] [w Integer] [h Integer] + [f (Nonnegative-Fixnum Nonnegative-Fixnum Nonnegative-Fixnum + Nonnegative-Fixnum -> Real)]) flomap]{ +Returns a @racket[w]×@racket[h] flomap with @racket[c] color components, with values defined by @racket[f]. + +The function @racket[f] receives four arguments @racket[k] @racket[x] @racket[y] @racket[i]: the color component, two positional coordinates, and a precalculated index into the flomap's @racketid[values] vector. +@examples[#:eval flomap-eval + (flomap->bitmap + (build-flomap 1 100 100 + (λ (k x y i) (/ (+ x y) 200)))) + (define sine-fm + (build-flomap + 1 100 100 + (λ (k x y i) + (* 1/2 (+ 1 (sin (sqrt (+ (sqr (- x 50)) + (sqr (- y 50)))))))))) + (flomap->bitmap sine-fm)] +} + +@defform[(inline-build-flomap c w h f)]{ +A macro version of @racket[build-flomap]. +The function or macro @racket[f] must return a @racket[Float], not a @racket[Real] as the @racket[f] argument to @racket[build-flomap] can. + +Using @racket[inline-build-flomap] instead of @racket[build-flomap] often ensures 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.} +} + +@defproc[(draw-flomap [draw (Any -> Any)] [w Integer] [h Integer]) flomap]{ +Returns a @racket[w]×@racket[h] bitmap drawn by @racket[draw]. +Think of it as the flomap version of @racketmodname[slideshow]'s @racket[dc]. + +The @racket[draw] function should accept a @racket[dc<%>] instance and use its drawing methods to draw on an underlying bitmap. +The bitmap is converted to a flomap using @racket[bitmap->flomap] and returned. +See @secref{flomap:title} for an example. + +This function is very difficult to use in Typed Racket, requiring occurrence checks for, and use of, experimental types. +However, as Typed Racket grows to handle Racket's object system, the types will be made more precise. +} + +@defproc[(flomap-multiply-alpha [fm flomap]) flomap] +@defproc[(flomap-divide-alpha [fm flomap]) flomap]{ +Multiplies/divides each nonzero-component value with the corresponding zero-component value. +Dividing by @racket[0.0] produces @racket[0.0]. + +In other words, @racket[flomap-multiply-alpha] converts non-alpha-multiplied flomaps into alpha-multiplied flomaps, +and @racket[flomap-divide-alpha] converts them back. + +You should not generally have to use these functions, because @racket[bitmap->flomap] returns an alpha-multiplied flomap and every alpha-aware flomap function assumes its arguments are alpha-multiplied and produces alpha-multiplied flomaps. + +See @secref{flomap:opacity} for a discussion of opacity (alpha) representation. +} + + +@; =================================================================================================== + + +@section{Component Operations} + +@defproc[(flomap-ref-component [fm flomap] [k Integer]) flomap]{ +Extracts one component of a flomap and returns it as a new flomap. +Raises an error if @racket[k] is out of bounds. + +Use this, for example, to extract the A and R components from an ARGB flomap: +@interaction[#:eval flomap-eval + (flomap->bitmap (flomap-ref-component fm 0)) + (flomap->bitmap (flomap-ref-component fm 1))] +} + +@defproc[(flomap-take-components [fm flomap] [k Integer]) flomap]{ +Extracts the first @racket[k] components and returns them as a new flomap. +Raises an error if @racket[k] is out of bounds. +@examples[#:eval flomap-eval (flomap->bitmap (flomap-take-components fm 2))] +} + +@defproc[(flomap-drop-components [fm flomap] [k Integer]) flomap]{ +Extracts all but the first @racket[k] components and returns them as a new flomap. +Raises an error if @racket[k] is out of bounds. + +Use this, for example, to operate on only the RGB channels of an ARGB flomap: +@interaction[#:eval flomap-eval + (flomap->bitmap + (flomap-append-components (flomap-take-components fm 1) + (fm* 0.25 (flomap-drop-components fm 1))))] +} + +@defproc[(flomap-append-components [fm0 flomap] [fm flomap] ...) flomap]{ +Appends the components of the given flomaps pointwise. +Raises an error if not all flomaps are the same width and height. + +@examples[#:eval flomap-eval + (equal? fm (flomap-append-components (flomap-take-components fm 2) + (flomap-drop-components fm 2))) + (flomap-append-components (make-flomap 1 10 10) + (make-flomap 3 20 20))] + +This function could behave according to the @secref{flomap:conceptual}---that is, expand the smaller ones to the largest size before appending. +However, appending the components of two different-size flomaps almost always indicates a logic or design error. +If it really is intended, use @racket[flomap-inset] or @racket[subflomap] to expand the smaller flomaps manually, with more control over the expansion. +} + + +@; =================================================================================================== + + +@section{Pointwise Operations} + +@defproc[(fmsqrt [fm flomap]) flomap] +@defproc[(fmsqr [fm flomap]) flomap]{ +Unary functions, lifted pointwise to operate on flomaps. +Defined as @racket[(inline-flomap-lift flsqrt)] and so on. + +For example, to estimate the local gradient magnitude at each point in a flomap: +@interaction[#:eval flomap-eval + (define-values (dx-fm dy-fm) + (flomap-gradient (flomap-drop-components fm 1))) + (flomap->bitmap + (fmsqrt (fm+ (fmsqr dx-fm) (fmsqr dy-fm))))] +} + +@defproc[(flomap-lift [f (Float -> Real)]) (flomap -> flomap)]{ +Lifts a unary floating-point function to operate pointwise on flomaps. +} + +@defform[(inline-flomap-lift f)]{ +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. + +@bold{This is not available in untyped Racket.} +} + +@defproc[(flomap-normalize [fm flomap]) flomap]{ +Returns a flomap like @racket[fm], but with values linearly rescaled to be between @racket[0.0] and @racket[1.0] inclusive. +@examples[#:eval flomap-eval + (define gray-fm + (build-flomap 1 100 100 (λ (k x y i) (+ 0.375 (/ (+ x y) 800))))) + (flomap->bitmap gray-fm) + (flomap->bitmap (flomap-normalize gray-fm))] +Besides increasing contrast, you could use this function to debug a rendering pipeline that produces overbright intermediate flomaps. +} + +@defproc[(fm+ [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap] +@defproc[(fm- [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap] +@defproc[(fm* [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap] +@defproc[(fm/ [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap] +@defproc[(fmmin [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap] +@defproc[(fmmax [fm1 (U Real flomap)] [fm2 (U Real flomap)]) flomap]{ +Arithmetic, @racket[flmin] and @racket[flmax] lifted to operate pointwise on flomaps. +Defined as @racket[(inline-flomap-lift2 +)] and so on. + +Binary operations accept the following argument combinations, in either order: +@(itemlist + @item{@bold{Two @racket[flomap]s.} Both flomaps must have the same number of components, or one of them must have one component. + If one flomap has one component, it is (conceptually) self-appended (see @racket[flomap-append-components]) as much as needed before the operation. + In either case, both flomaps must have the same width and height.} + @item{@bold{One @racket[flomap], one @racket[Real].} In this case, the real value is (conceptually) made into a uniform flomap (see @racket[make-flomap]) before applying the operation.} + ) +Any other argument combination will raise a type error. + +@examples[#:eval flomap-eval + (define fm1 (build-flomap 1 260 240 (λ (k x y i) (/ (+ x y) 500)))) + (define fm2 (fm- 1.0 fm1)) + (flomap->bitmap fm1) + (flomap->bitmap fm2) + (flomap->bitmap (fmmax fm1 fm2)) + (flomap->bitmap (fm* fm1 fm)) + (fm/ (make-flomap 1 10 10 0.5) + (make-flomap 1 30 30 0.25))] +} + +Binary pointwise operators could behave according to the @secref{flomap:conceptual}---that is, expand the smaller one to the larger size by filling it with @racket[0.0]. +However, operating on the components of two different-size flomaps almost always indicates a logic or design error. +If it really is intended, use @racket[flomap-inset] or @racket[subflomap] to expand the smaller flomap manually, with more control over the expansion. + +Because @racket[fm] is an alpha-multiplied flomap (see @secref{flomap:opacity}), multiplying each component by a scalar less than @racket[1.0] results in a more transparent flomap: +@interaction[#:eval flomap-eval + (flomap->bitmap (fm* fm 0.2))] + +@defproc[(flomap-lift2 [f (Flonum Flonum -> 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. +} + +@defform[(inline-flomap-lift2 f)]{ +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. + +@bold{This is not available in untyped Racket.} +} + + +@; =================================================================================================== + + +@section{Gradients and Normals} + +@defproc[(flomap-gradient-x [fm flomap]) flomap] +@defproc[(flomap-gradient-y [fm flomap]) flomap]{ +These return, per-component, estimates of the local @italic{x}- and @italic{y}-directional derivatives using a 3×3 @link["http://en.wikipedia.org/wiki/Sobel_operator#Alternative_operators"]{Scharr operator}. +} + +@defproc[(flomap-gradient [fm flomap]) (values flomap flomap)]{ +Equivalent to @racket[(values (flomap-gradient-x fm) (flomap-gradient-y fm))]. + +@examples[#:eval flomap-eval + (let-values ([(dx-fm dy-fm) (flomap-gradient + (flomap-drop-components fm 1))]) + (values (flomap->bitmap (fm* 0.5 (fm+ 1.0 dx-fm))) + (flomap->bitmap (fm* 0.5 (fm+ 1.0 dy-fm)))))] +} + +@defproc[(flomap-gradient-normal [fm flomap]) flomap]{ +Given a one-component flomap, returns a @racket[3]-component flomap containing estimated normals. +In other words, @racket[flomap-normal] converts height maps to normal maps. +@examples[#:eval flomap-eval + (flomap->bitmap sine-fm) + (flomap->bitmap (flomap-gradient-normal sine-fm))] +} + + +@; =================================================================================================== + + +@section{Blur} + +@defproc[(flomap-gaussian-blur [fm flomap] [xσ Real] [yσ Real xσ]) flomap]{ +Returns @racket[fm] convolved, per-component, with an axis-aligned Gaussian kernel with standard deviations @racket[xσ] and @racket[yσ]. + +If perfect Gaussian blur is not important, use @racket[flomap-blur] instead, which approximates Gaussian blur closely and is faster. + +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-gaussian-blur (flomap-inset fm 12) 4)) + (flomap->bitmap (flomap-gaussian-blur (flomap-inset fm 12 3) 4 1))] +} + +@defproc[(flomap-gaussian-blur-x [fm flomap] [σ Real]) flomap]{ +Returns @racket[fm] convolved, per-component and per-row, with a Gaussian kernel with standard deviation @racket[σ]. + +If perfect Gaussian blur is not important, use @racket[flomap-blur-x] instead, which approximates Gaussian blur closely and is usually much faster. + +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-gaussian-blur-x (flomap-inset fm 12 0) 4))] +} + +@defproc[(flomap-gaussian-blur-y [fm flomap] [σ Real]) flomap]{ +Like @racket[flomap-gaussian-blur-x], but per-column instead of per-row. +} + +@defproc[(flomap-box-blur [fm flomap] [x-radius Real] [y-radius Real x-radius]) flomap]{ +Returns @racket[fm] convolved, per-component, with a box kernel with radii @racket[x-radius] and @racket[y-radius]. +The radii are of the largest ellipse that would fit in the box. +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-box-blur (flomap-inset fm 4) 4)) + (flomap->bitmap (flomap-box-blur (flomap-inset fm 4 1) 4 1))] +} + +@defproc[(flomap-box-blur-x [fm flomap] [radius Real]) flomap]{ +Returns @racket[fm] convolved, per-component and per-row, with a box kernel with radius @racket[radius]. +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-box-blur-x (flomap-inset fm 4 0) 4))] +} + +@defproc[(flomap-box-blur-y [fm flomap] [radius Real]) flomap]{ +Like @racket[flomap-box-blur-x], but per-column instead of per-row. +} + +@defproc[(flomap-blur [fm flomap] [xσ Real] [yσ Real xσ]) flomap]{ +Returns approximately the result of @racket[(flomap-gaussian-blur fm xσ yσ)]. + +Gaussian blur, as it is implemented by @racket[flomap-gaussian-blur], is O(@racket[xσ] + @racket[yσ]) for any fixed flomap size. +On the other hand, @racket[flomap-blur] is O(1) for the same size. +@examples[#:eval flomap-eval + (define gauss-blur-fm (time (flomap-gaussian-blur fm 12))) + (define blur-fm (time (flomap-blur fm 12))) + (flomap-extreme-values + (fmsqr (fm- gauss-blur-fm blur-fm)))] +} + +@defproc[(flomap-blur-x [fm flomap] [xσ Real]) flomap]{ +Like @racket[flomap-blur], but blurs per-row only. +} + +@defproc[(flomap-blur-y [fm flomap] [yσ Real]) flomap]{ +Like @racket[flomap-blur], but blurs per-column only. +} + + +@; =================================================================================================== + + +@section{Resizing} + +@defproc[(flomap-copy [fm flomap] [x-start Integer] [y-start Integer] [x-end Integer] [y-end Integer]) flomap]{ +Returns the part of @racket[fm] for which the @racket[x] coordinate is @racket[x-start] ≤ @racket[x] < @racket[x-end] and the @racket[y] coordinate is @racket[y-start] ≤ @racket[y] < @racket[y-end]. +If @racket[x-start] ≥ @racket[x-end], the result is width @racket[0], and if @racket[y-start] ≥ @racket[y-end], the result is height @racket[0]. + +The interval arguments may identify a rectangle with points outside the bounds of @racket[fm]. +In this case, the points' values in the returned flomap are @racket[0.0], as per the @secref{flomap:conceptual}. + +This function is guaranteed to return a copy. +} + +@defproc[(subflomap [fm flomap] [x-start Integer] [y-start Integer] [x-end Integer] [y-end Integer]) flomap]{ +Like @racket[flomap-copy], but returns @racket[fm] when @racket[x-start] and @racket[y-start] are @racket[0], and @racket[x-end] and @racket[y-end] are respectively the width and height of @racket[fm]. + +Use @racket[subflomap] instead of @racket[flomap-copy] when programming functionally. +Every library function that returns parts of a flomap (such as @racket[flomap-trim] and @racket[flomap-inset]) is defined using @racket[subflomap]. +} + +@defproc[(flomap-trim [fm flomap] [alpha? Boolean #t]) flomap]{ +Shrinks @racket[fm] to its largest nonzero rectangle. +If @racket[alpha?] is @racket[#t], it uses only component 0 to determine the largest nonzero rectangle; otherwise, it uses every component. + +This function cannot return a larger flomap. + +@examples[#:eval flomap-eval + (define small-circle-fm + (draw-flomap (λ (dc) + (send dc draw-ellipse 20 20 10 10)) + 100 100)) + (flomap->bitmap small-circle-fm) + (flomap->bitmap (flomap-trim small-circle-fm))] +See @racket[flomap-nonzero-rect]. +} + +@defproc*[([(flomap-inset [fm flomap] [amt Integer]) flomap] + [(flomap-inset [fm flomap] [h-amt Integer] [v-amt Integer]) flomap] + [(flomap-inset [fm flomap] [l-amt Integer] [t-amt Integer] [r-amt Integer] [b-amt Integer]) flomap])]{ +Extends @racket[fm] by some amount on each side, filling any new values with @racket[0.0]. +Positive inset amounts grow the flomap; negative insets shrink it. +Large negative insets may shrink it to 0×0, which is a valid flomap size. +@examples[#:eval flomap-eval (flomap->bitmap (flomap-inset fm -10 20 -30 -40))] +} + +@defproc[(flomap-crop [fm flomap] [w Integer] [h Integer] [left-frac Real] [top-frac Real]) flomap]{ +Shrinks or grows @racket[fm] to be size @racket[w]×@racket[h]. +The proportion of points removed/added to the left and top are given by @racket[left-frac] and @racket[top-frac]; +e.g. @racket[left-frac] = @racket[1/2] causes the same number to be removed/added to the left and right sides. + +You will most likely want to use one of the following cropping functions instead, which are defined using @racket[flomap-crop]. +} + +@defproc[(flomap-lt-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-lc-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-lb-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-ct-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-cc-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-cb-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-rt-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-rc-crop [fm flomap] [w Integer] [h Integer]) flomap] +@defproc[(flomap-rb-crop [fm flomap] [w Integer] [h Integer]) flomap]{ +These shrink or grow @racket[fm] to be size @racket[w]×@racket[h]. +The two-letter abbreviation determines which area of the flomap is preserved. +For example, @racket[flomap-lt-crop] (``flomap left-top crop'') preserves the left-top corner: +@interaction[#:eval flomap-eval (flomap->bitmap (flomap-lt-crop fm 150 150))] +} + +@defproc[(flomap-scale [fm flomap] [x-scale Real] [y-scale Real x-scale]) flomap]{ +Scales @racket[fm] to a proportion of its size. +Uses bilinear interpolation to sample between integer coordinates, and reduces resolution (blurs) correctly before downsampling so that shrunk images are still sharp but not aliased (pixelated-looking). +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-scale fm 1/8)) + (flomap->bitmap (flomap-scale sine-fm 4)) + (flomap-scale fm 0)] +} + +@defproc[(flomap-resize [fm flomap] [w (Option Integer)] [h (Option Integer)]) flomap]{ +Like @racket[flomap-scale], but accepts a width @racket[w] and height @racket[h] instead of scaling proportions. +If either size is @racket[#f], the flomap is scaled in that direction to maintain its aspect ratio. +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-resize fm 50 #f)) + (flomap->bitmap (flomap-resize fm #f 50)) + (flomap->bitmap (flomap-resize fm 20 50)) + (flomap-resize fm 0 0)] +} + + +@; =================================================================================================== + + +@section{Compositing} + +Unless stated otherwise, compositing functions assume every flomap argument has an alpha component. + +@defproc*[([(flomap-pin [fm1 flomap] [x1 Integer] [y1 Integer] [fm2 flomap]) flomap] + [(flomap-pin [fm1 flomap] [x1 Integer] [y1 Integer] + [fm2 flomap] [x2 Integer] [y2 Integer]) flomap])]{ +Superimposes @racket[fm2] over @racket[fm1] so that point @racket[x2] @racket[y2] on flomap @racket[f2] is directly over point @racket[x1] @racket[y1] on flomap @racket[f1]. +If @racket[x2] and @racket[y2] are not provided, they are assumed to be @racket[0]. +The result is expanded as necessary. + +@racket[fm1] and @racket[fm2] must have the same number of components. + +@examples[#:eval flomap-eval + (flomap-pin fm -10 -10 sine-fm) + (define circle-fm + (draw-flomap (λ (the-dc) + (send the-dc set-pen "black" 4 'short-dash) + (send the-dc set-brush "yellow" 'solid) + (send the-dc set-alpha 1/2) + (send the-dc draw-ellipse 2 2 124 124)) + 128 128)) + (flomap->bitmap (flomap-pin fm 0 0 circle-fm 64 64)) + (flomap->bitmap (flomap-pin sine-fm 50 0 sine-fm))] + +The other compositing functions are defined in terms of @racket[flomap-pin]. +} + +@defproc[(flomap-pin* [x1-frac Real] [y1-frac Real] + [x2-frac Real] [y2-frac Real] + [fm0 flomap] [fm flomap] ...) flomap]{ +For each adjacent pair @racket[fm1] @racket[fm2] in the argument list, pins @racket[fm2] over @racket[fm1]. + +The pin-over points are calculated from the four real arguments as follows. +If @racket[fm1] is size @racket[w1]×@racket[h1], then @racket[x1] = @racket[(* w1 x1-frac)] and @racket[y1] = @racket[(* h1 y1-frac)], and similarly for @racket[x2] and @racket[y2]. + +The following example pins the upper-left corner of each @racket[fm2] over a point near the upper-left corner of each @racket[fm1]: +@interaction[#:eval flomap-eval + (flomap->bitmap (flomap-pin* 1/8 1/8 0 0 + circle-fm circle-fm circle-fm))] + +All the flomap superimpose and append functions are defined using @racket[flomap-pin*] with different pin-over point fractions. +For example, @racket[(flomap-lt-superimpose fm0 fm ...)] = @racket[(flomap-pin* 0 0 0 0 fm0 fm ...)], +and @racket[(flomap-vc-append fm0 fm ...)] = @racket[(flomap-pin* 1/2 1 1/2 0 fm0 fm ...)]. +} + +@defproc[(flomap-lt-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-lc-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-lb-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-ct-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-cc-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-cb-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-rt-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-rc-superimpose [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-rb-superimpose [fm0 flomap] [fm flomap] ...) flomap]{ +These create a new flomap by superimposing the flomaps in the argument list. +The two-letter abbreviation determines the pin-over points. +For example, @racket[flomap-lt-superimpose] (``flomap left-top superimpose'') pins points @racket[0] @racket[0] together on each adjacent pair of flomaps: +@interaction[#:eval flomap-eval + (flomap->bitmap (flomap-lt-superimpose fm circle-fm))] +See @racket[flomap-pin] and @racket[flomap-pin*] for implementation details. +} + +@defproc[(flomap-vl-append [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-vc-append [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-vr-append [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-ht-append [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-hc-append [fm0 flomap] [fm flomap] ...) flomap] +@defproc[(flomap-hb-append [fm0 flomap] [fm flomap] ...) flomap]{ +These create a new flomap by spatially appending the flomaps in the argument list. +The two-letter abbreviation determines direction (@racket[v] or @racket[h]) and alignment (@racket[l], @racket[c], @racket[r], or @racket[t], @racket[c], @racket[b]). +@examples[#:eval flomap-eval + (flomap->bitmap (flomap-ht-append circle-fm fm circle-fm))] +See @racket[flomap-pin] and @racket[flomap-pin*] for implementation details. +} + + +@; =================================================================================================== + + +@;@section{Transformations} + + +@; =================================================================================================== + + +@;@section{Effects} + + +@close-eval[flomap-eval] diff --git a/collects/images/scribblings/images.scrbl b/collects/images/scribblings/images.scrbl index e6d7d89cd2..ec9d3091c2 100644 --- a/collects/images/scribblings/images.scrbl +++ b/collects/images/scribblings/images.scrbl @@ -10,12 +10,15 @@ The idea is to make it easy to include such things in your own programs. Generally, the images in this library are computed when requested, not loaded from disk. Most of them are drawn on a @racket[dc<%>] and then @link["http://en.wikipedia.org/wiki/Ray_tracing_%28graphics%29"]{ray traced}. -This can become computationally expensive, so this library also includes @racketmodname[images/compile-time], which makes it easy to compute images at compile time and access them at run time. +Ray tracing images can become computationally expensive, so this library also includes @racketmodname[images/compile-time], which makes it easy to compute images at compile time and access them at run time. + +The ray tracing API will eventually be finalized and made public. +This Racket release begins doing so by finalizing and making public the basic image API used by the ray tracer. +It is provided by the @racketmodname[images/flomap] module. @table-of-contents[] @include-section["icons.scrbl"] - @include-section["logos.scrbl"] - @include-section["compile-time.scrbl"] +@include-section["flomap.scrbl"] diff --git a/collects/images/tests/effects-tests.rkt b/collects/images/tests/effects-tests.rkt index 9e59d171c5..d096e4aac4 100644 --- a/collects/images/tests/effects-tests.rkt +++ b/collects/images/tests/effects-tests.rkt @@ -17,15 +17,15 @@ (define end-frame-quality 90) (define mid-frame-quality 35) - (define background-fm (make-flomap/components size size '(1 1 1 1))) + (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 '(0 0 0.1))) + blur (flvector 0.0 0.0 0.1))) (define racket-fm (flomap-shadowed (flomap-inset (racket-flomap (- size (* 4 blur))) (* 2 blur)) - blur '(0.1 0 0))) + blur (flvector 0.1 0.0 0.0))) (define logo-flomap* (flomap-whirl-morph plt-fm racket-fm))