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

images/flomap: public interface to floating-point bitmaps used by ray tracer

Browse Source
This commit is contained in:
Neil Toronto 2012-05-29 17:50:32 -06:00
parent 2f23f1b6b3
commit c7bea1dfcd
22 changed files with 1493 additions and 649 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/images/flomap.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang typed/racket/base
(require "private/flomap.rkt")
(provide (all-from-out "private/flomap.rkt"))

34
collects/images/icons/arrow.rkt
View File

@ -25,28 +25,28 @@
) flomap? ) flomap?
(let ([color (->color% color)]) (let ([color (->color% color)])
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 9) '(15 . 9) '(14 . 0) (send dc draw-polygon (list '(0 . 9) '(15 . 9) '(14 . 0)
'(31 . 15.5) '(31 . 15.5)
'(14 . 31) '(15 . 22) '(0 . 22)))) '(14 . 31) '(15 . 22) '(0 . 22))))
(/ height 32)))) 32 32 (/ height 32))))
(defproc (flat-right-over-arrow-flomap [color (or/c string? (is-a?/c color%))] (defproc (flat-right-over-arrow-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0))] [height (and/c rational? (>=/c 0))]
) flomap? ) flomap?
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc '((m 0 15) (draw-path-commands dc '((m 0 15)
(c 9 -14 19.5 -8 24 -2) (c 9 -14 19.5 -8 24 -2)
(l 5 -7 2 20 -20 -2 7 -5) (l 5 -7 2 20 -20 -2 7 -5)
(c -2.5 -4 -8 -8.5 -14 0) (c -2.5 -4 -8 -8.5 -14 0)
(l -4 -4)) (l -4 -4))
0 0)) 0 0))
(/ height 32))) 32 32 (/ height 32)))
(defproc (right-arrow-flomap [color (or/c string? (is-a?/c color%))] (defproc (right-arrow-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]

54
collects/images/icons/control.rkt
View File

@ -26,14 +26,13 @@
(define (flat-play-flomap color height) (define (flat-play-flomap color height)
(draw-icon-flomap (draw-icon-flomap
24 32
(λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-polygon (list (cons 0 0) (cons 4 0) (send dc draw-polygon (list (cons 0 0) (cons 4 0)
(cons 23 13) (cons 23 18) (cons 23 13) (cons 23 18)
(cons 4 31) (cons 0 31)))) (cons 4 31) (cons 0 31))))
(/ height 32))) 24 32 (/ height 32)))
(defproc (play-flomap [color (or/c string? (is-a?/c color%))] (defproc (play-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -50,15 +49,15 @@
) flomap? ) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(define fm (draw-rendered-icon-flomap (define fm
20 32 (λ (dc) (draw-rendered-icon-flomap
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (λ (dc)
(send dc set-brush color 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc draw-polygon (list (cons 0 0) (cons 4 0) (send dc set-brush color 'solid)
(cons 19 13) (cons 19 18) (send dc draw-polygon (list (cons 0 0) (cons 4 0)
(cons 4 31) (cons 0 31)))) (cons 19 13) (cons 19 18)
(/ height 32) (cons 4 31) (cons 0 31))))
material)) 20 32 (/ height 32) material))
(flomap-hc-append fm fm))) (flomap-hc-append fm fm)))
(defproc (stop-flomap [color (or/c string? (is-a?/c color%))] (defproc (stop-flomap [color (or/c string? (is-a?/c color%))]
@ -68,12 +67,11 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 0) '(31 . 0) '(31 . 31) '(0 . 31)))) (send dc draw-polygon (list '(0 . 0) '(31 . 0) '(31 . 31) '(0 . 31))))
(/ height 32) 32 32 (/ height 32) material)))
material)))
(defproc (record-flomap [color (or/c string? (is-a?/c color%))] (defproc (record-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -82,12 +80,11 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-ellipse 0 0 31 31)) (send dc draw-ellipse 0 0 31 31))
(/ height 32) 32 32 (/ height 32) material)))
material)))
(defproc (bar-flomap [color (or/c string? (is-a?/c color%))] (defproc (bar-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -96,12 +93,11 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
8 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 0) '(7 . 0) '(7 . 31) '(0 . 31)))) (send dc draw-polygon (list '(0 . 0) '(7 . 0) '(7 . 31) '(0 . 31))))
(/ height 32) 8 32 (/ height 32) material)))
material)))
(defproc (back-flomap [color (or/c string? (is-a?/c color%))] (defproc (back-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]

92
collects/images/icons/file.rkt
View File

@ -26,20 +26,20 @@
(define metal-fm (define metal-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
18 11 (λ (dc) (λ (dc)
(send dc set-background "lightgray") (send dc set-background "lightgray")
(define outer-path (new dc-path%)) (define outer-path (new dc-path%))
(send outer-path rounded-rectangle 0.5 0.5 13 12 1) (send outer-path rounded-rectangle 0.5 0.5 13 12 1)
(define inner-path (new dc-path%)) (define inner-path (new dc-path%))
(send inner-path rectangle 2.5 2.5 4 6) (send inner-path rectangle 2.5 2.5 4 6)
(define outer-rgn (new region%)) (define outer-rgn (new region%))
(send outer-rgn set-path outer-path) (send outer-rgn set-path outer-path)
(define inner-rgn (new region%)) (define inner-rgn (new region%))
(send inner-rgn set-path inner-path) (send inner-rgn set-path inner-path)
(send outer-rgn subtract inner-rgn) (send outer-rgn subtract inner-rgn)
(send dc set-clipping-region outer-rgn) (send dc set-clipping-region outer-rgn)
(send dc clear)) (send dc clear))
scale)] 18 11 scale)]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-icon-style dfm)] [dfm (deep-flomap-icon-style dfm)]
[dfm (deep-flomap-scale-z dfm 1/16)]) [dfm (deep-flomap-scale-z dfm 1/16)])
@ -47,50 +47,50 @@
(define bottom-indent-fm (define bottom-indent-fm
(draw-icon-flomap (draw-icon-flomap
20 11 (λ (dc) (λ (dc)
(send dc set-alpha 1/4) (send dc set-alpha 1/4)
(send dc set-pen "black" 1 'transparent) (send dc set-pen "black" 1 'transparent)
(send dc set-brush "black" 'solid) (send dc set-brush "black" 'solid)
(send dc draw-rounded-rectangle 1.5 0.5 18 11 1)) (send dc draw-rounded-rectangle 1.5 0.5 18 11 1))
scale)) 20 11 scale))
(define label-fm (define label-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
22 20 (λ (dc) (λ (dc)
(send dc set-pen "black" 1 'transparent) (send dc set-pen "black" 1 'transparent)
(send dc set-brush "black" 'solid) (send dc set-brush "black" 'solid)
(send dc draw-rounded-rectangle -0.5 -3.5 22 21 3) (send dc draw-rounded-rectangle -0.5 -3.5 22 21 3)
(send dc set-brush "lemonchiffon" 'solid) (send dc set-brush "lemonchiffon" 'solid)
(send dc draw-rounded-rectangle 0.5 -3.5 20 20 2) (send dc draw-rounded-rectangle 0.5 -3.5 20 20 2)
(send dc set-brush "chocolate" 'solid) (send dc set-brush "chocolate" 'solid)
(send dc draw-rectangle 0.5 -0.5 20 4) (send dc draw-rectangle 0.5 -0.5 20 4)
(send dc set-brush "navy" 'solid) (send dc set-brush "navy" 'solid)
(for ([i (in-range 5.5 15 3)]) (for ([i (in-range 5.5 15 3)])
(send dc draw-rectangle 2.5 i 16 1))) (send dc draw-rectangle 2.5 i 16 1)))
scale)] 22 20 scale)]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-bulge-vertical dfm (* 2 scale))]) [dfm (deep-flomap-bulge-vertical dfm (* 2 scale))])
(deep-flomap-render-icon dfm matte-material))) (deep-flomap-render-icon dfm matte-material)))
(define top-indent-fm (define top-indent-fm
(draw-icon-flomap (draw-icon-flomap
22 19 (λ (dc) (λ (dc)
(send dc set-alpha 1) (send dc set-alpha 1)
(send dc set-pen "black" 1 'transparent) (send dc set-pen "black" 1 'transparent)
(send dc set-brush "black" 'solid) (send dc set-brush "black" 'solid)
(send dc draw-rounded-rectangle -0.5 -2.5 22 20 2.5)) (send dc draw-rounded-rectangle -0.5 -2.5 22 20 2.5))
scale)) 22 19 scale))
(define case-fm (define case-fm
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 3) '(3 . 0) (send dc draw-polygon (list '(0 . 3) '(3 . 0)
'(28 . 0) '(31 . 3) '(28 . 0) '(31 . 3)
'(31 . 28) '(28 . 31) '(31 . 28) '(28 . 31)
'(3 . 31) '(0 . 28)))) '(3 . 31) '(0 . 28))))
scale)) 32 32 scale))
(define disk-fm (define disk-fm
(let* ([dfm (deep-flomap-ct-superimpose (let* ([dfm (deep-flomap-ct-superimpose

399
collects/images/icons/misc.rkt
View File

@ -27,17 +27,17 @@
(define (flat-regular-polygon-flomap sides start color size) (define (flat-regular-polygon-flomap sides start color size)
(let ([start (- start)]) (let ([start (- start)])
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(define dθ (/ (* 2 pi) sides)) (define dθ (/ (* 2 pi) sides))
(define θs (sequence->list (in-range start (+ start (* 2 pi)) dθ))) (define θs (sequence->list (in-range start (+ start (* 2 pi)) dθ)))
(define max-frac (apply max (append (map (compose abs cos) θs) (define max-frac (apply max (append (map (compose abs cos) θs)
(map (compose abs sin) θs)))) (map (compose abs sin) θs))))
(send dc draw-polygon (for/list ([θ (in-list θs)]) (send dc draw-polygon (for/list ([θ (in-list θs)])
(cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac)) (cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac))
(+ 15.5 (/ (* 15.5 (sin θ)) max-frac)))))) (+ 15.5 (/ (* 15.5 (sin θ)) max-frac))))))
(/ size 32)))) 32 32 (/ size 32))))
(defproc (regular-polygon-flomap [sides exact-positive-integer?] (defproc (regular-polygon-flomap [sides exact-positive-integer?]
[start real?] [start real?]
@ -83,17 +83,16 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-ellipse 4 8 23 23) (send dc draw-ellipse 4 8 23 23)
(send dc draw-ellipse 0 10 4 3.5) (send dc draw-ellipse 0 10 4 3.5)
(send dc draw-ellipse 3 4.5 4.5 4.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 8.75 1 5.25 5.25)
(send dc draw-ellipse 16 0 6 6) (send dc draw-ellipse 16 0 6 6)
(send dc draw-ellipse 23.5 1.5 7.5 9)) (send dc draw-ellipse 23.5 1.5 7.5 9))
(/ height 32) 32 32 (/ height 32) material)))
material)))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
;; Magnifying glass ;; Magnifying glass
@ -115,11 +114,11 @@
(define scale (/ height 32)) (define scale (/ height 32))
(define glass-fm (define glass-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
18 18 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color "azure") 1 'solid) (set-icon-pen dc (icon-color->outline-color "azure") 1 'solid)
(send dc set-brush "azure" 'solid) (send dc set-brush "azure" 'solid)
(send dc draw-ellipse 0 0 17 17)) (send dc draw-ellipse 0 0 17 17))
scale)] 18 18 scale)]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-bulge-spheroid dfm (* 4 scale))] [dfm (deep-flomap-bulge-spheroid dfm (* 4 scale))]
[dfm (deep-flomap-raise dfm (* 4 scale))]) [dfm (deep-flomap-raise dfm (* 4 scale))])
@ -127,21 +126,21 @@
(define circle-fm (define circle-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
28 28 (λ (dc) (λ (dc)
(define outline-color (icon-color->outline-color frame-color)) (define outline-color (icon-color->outline-color frame-color))
(send dc set-pen outline-color 3 'solid) (send dc set-pen outline-color 3 'solid)
(send dc set-brush outline-color 'solid) (send dc set-brush outline-color 'solid)
(send dc draw-ellipse 1 1 25 25) (send dc draw-ellipse 1 1 25 25)
(send dc set-pen frame-color 1 'solid) (send dc set-pen frame-color 1 'solid)
(send dc set-brush frame-color 'solid) (send dc set-brush frame-color 'solid)
(send dc draw-ellipse 1 1 25 25)) (send dc draw-ellipse 1 1 25 25))
scale)] 28 28 scale)]
[indent-fm (draw-icon-flomap [indent-fm (draw-icon-flomap
28 28 (λ (dc) (λ (dc)
(send dc set-pen frame-color 1 'solid) (send dc set-pen frame-color 1 'solid)
(send dc set-brush frame-color 'solid) (send dc set-brush frame-color 'solid)
(send dc draw-ellipse 5 5 17 17)) (send dc draw-ellipse 5 5 17 17))
scale)] 28 28 scale)]
[indent-dfm (flomap->deep-flomap indent-fm)] [indent-dfm (flomap->deep-flomap indent-fm)]
[indent-dfm (deep-flomap-raise indent-dfm (* -4 scale))] [indent-dfm (deep-flomap-raise indent-dfm (* -4 scale))]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
@ -152,17 +151,17 @@
(define handle-fm (define handle-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
11 11 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color handle-color) 1 'solid) (set-icon-pen dc (icon-color->outline-color handle-color) 1 'solid)
(send dc set-brush handle-color 'solid) (send dc set-brush handle-color 'solid)
(define p (new dc-path%)) (define p (new dc-path%))
(send p move-to 4 0) (send p move-to 4 0)
(send p line-to 10 5) (send p line-to 10 5)
(send p curve-to 10 8 8 10 5 10) (send p curve-to 10 8 8 10 5 10)
(send p line-to 0 4) (send p line-to 0 4)
(send p move-to 4 0) (send p move-to 4 0)
(send dc draw-path p)) (send dc draw-path p))
scale)]) 11 11 scale)])
(flomap-render-icon fm material))) (flomap-render-icon fm material)))
(flomap-pin* 0 0 21/28 21/28 (flomap-pin* 0 0 21/28 21/28
@ -189,20 +188,20 @@
(define scale (/ height 32)) (define scale (/ height 32))
(define fuse-fm (define fuse-fm
(let* ([fm (draw-icon-flomap (let* ([fm (draw-icon-flomap
10 25 (λ (dc) (λ (dc)
(send dc set-pen "darkred" 1 'solid) (send dc set-pen "darkred" 1 'solid)
(send dc set-brush "gold" 'solid) (send dc set-brush "gold" 'solid)
(draw-path-commands dc '((m 3.5 0) (draw-path-commands dc '((m 3.5 0)
(c -5 0 -3.29080284 10.4205 -3 11.5 (c -5 0 -3.29080284 10.4205 -3 11.5
1.1137011 4.1343 2 6.5 0 8.5 1.1137011 4.1343 2 6.5 0 8.5
-0.5711131 2.0524 1.5 4 3.5 3.5 -0.5711131 2.0524 1.5 4 3.5 3.5
2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5 2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5
-2 -7 -2 -9 -1.5 -9 -2 -7 -2 -9 -1.5 -9
0 1 -0.5 2 1 3.5 0 1 -0.5 2 1 3.5
2 0.5 4 -1.5 3.5 -3.5 2 0.5 4 -1.5 3.5 -3.5
-2 -2 -2 -5 -5.5 -5)) -2 -2 -2 -5 -5.5 -5))
0 0)) 0 0))
scale)] 10 25 scale)]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-icon-style dfm)] [dfm (deep-flomap-icon-style dfm)]
[dfm (deep-flomap-scale-z dfm 1)]) [dfm (deep-flomap-scale-z dfm 1)])
@ -210,19 +209,19 @@
(define (bomb-cap-flomap color) (define (bomb-cap-flomap color)
(draw-icon-flomap (draw-icon-flomap
20 20 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc '((m 1.5 11.5) (draw-path-commands dc '((m 1.5 11.5)
(l 10 -10 2.5 2.5) (l 10 -10 2.5 2.5)
(c 4 5 -5 14 -10 10) (c 4 5 -5 14 -10 10)
(l -2.5 -2.5)) (l -2.5 -2.5))
0 0) 0 0)
(draw-path-commands dc '((m 1.5 11.5) (draw-path-commands dc '((m 1.5 11.5)
(c -2 -5 5 -12 10 -10 (c -2 -5 5 -12 10 -10
4 5 -5 14 -10 10)) 4 5 -5 14 -10 10))
0 0)) 0 0))
scale)) 20 20 scale))
(define cap-fm (define cap-fm
(let* ([cap-fm (bomb-cap-flomap cap-color)] (let* ([cap-fm (bomb-cap-flomap cap-color)]
@ -232,11 +231,11 @@
(define sphere-fm (define sphere-fm
(let* ([sphere-fm (draw-icon-flomap (let* ([sphere-fm (draw-icon-flomap
30 30 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color bomb-color) 1 'solid) (set-icon-pen dc (icon-color->outline-color bomb-color) 1 'solid)
(send dc set-brush bomb-color 'solid) (send dc set-brush bomb-color 'solid)
(send dc draw-ellipse 0 0 29 29)) (send dc draw-ellipse 0 0 29 29))
scale)] 30 30 scale)]
[cap-fm (bomb-cap-flomap cap-color)] [cap-fm (bomb-cap-flomap cap-color)]
[cap-dfm (flomap->deep-flomap cap-fm)] [cap-dfm (flomap->deep-flomap cap-fm)]
[cap-dfm (deep-flomap-raise cap-dfm (* -2 scale))] [cap-dfm (deep-flomap-raise cap-dfm (* -2 scale))]
@ -280,69 +279,67 @@
(flomap-cc-superimpose (flomap-cc-superimpose
;; face and ticks ;; face and ticks
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color (icon-color->outline-color face-color)) (set-icon-pen dc (icon-color->outline-color (icon-color->outline-color face-color))
1 'solid) 1 'solid)
(send dc set-brush face-color 'solid) (send dc set-brush face-color 'solid)
(send dc draw-ellipse 0 0 31 31) (send dc draw-ellipse 0 0 31 31)
(set-icon-pen dc "black" 1 'solid) (set-icon-pen dc "black" 1 'solid)
(for ([i (in-range 60)] (for ([i (in-range 60)]
[r (in-cycle (list 1.5 .5 .5 .5 .5 [r (in-cycle (list 1.5 .5 .5 .5 .5
1.0 .5 .5 .5 .5 1.0 .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 [t (in-cycle (list 1.0 .25 .25 .25 .25
.75 .25 .25 .25 .25 .75 .25 .25 .25 .25
.75 .25 .25 .25 .25))]) .75 .25 .25 .25 .25))])
(define θ (* i (* 1/30 pi))) (define θ (* i (* 1/30 pi)))
(set-icon-pen dc "black" t 'solid) (set-icon-pen dc "black" t 'solid)
(send dc draw-line (send dc draw-line
(+ 15.5 (* (- R r) (cos θ))) (+ 15.5 (* (- R r) (cos θ)))
(+ 15.5 (* (- R r) (sin θ))) (+ 15.5 (* (- R r) (sin θ)))
(+ 15.5 (* R (cos θ))) (+ 15.5 (* R (cos θ)))
(+ 15.5 (* R (sin θ)))))) (+ 15.5 (* R (sin θ))))))
scale) 32 32 scale)
;; lambda logo ;; lambda logo
(fm* 0.33 (lambda-flomap face-color (* 1/2 height) glass-icon-material)) (fm* 0.33 (lambda-flomap face-color (* 1/2 height) glass-icon-material))
;; minute hand ;; minute hand
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid)
(send dc set-brush hand-color 'solid) (send dc set-brush hand-color 'solid)
(send dc draw-polygon (send dc draw-polygon
(list (cons (+ 15.5 (* R (cos minute-θ))) (list (cons (+ 15.5 (* R (cos minute-θ)))
(+ 15.5 (* R (sin minute-θ)))) (+ 15.5 (* R (sin minute-θ))))
(cons (+ 15.5 (* 1 (cos (+ minute-θ (* 1/2 pi))))) (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 1/2 pi)))))
(+ 15.5 (* 1 (sin (+ minute-θ (* 1/2 pi)))))) (+ 15.5 (* 1 (sin (+ minute-θ (* 1/2 pi))))))
(cons (+ 15.5 (* 1 (cos (+ minute-θ pi)))) (cons (+ 15.5 (* 1 (cos (+ minute-θ pi))))
(+ 15.5 (* 1 (sin (+ minute-θ pi))))) (+ 15.5 (* 1 (sin (+ minute-θ pi)))))
(cons (+ 15.5 (* 1 (cos (+ minute-θ (* 3/2 pi))))) (cons (+ 15.5 (* 1 (cos (+ minute-θ (* 3/2 pi)))))
(+ 15.5 (* 1 (sin (+ minute-θ (* 3/2 pi))))))))) (+ 15.5 (* 1 (sin (+ minute-θ (* 3/2 pi)))))))))
scale 32 32 scale metal-icon-material)
metal-icon-material)
;; hour hand ;; hour hand
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid)
(send dc set-brush hand-color 'solid) (send dc set-brush hand-color 'solid)
(send dc draw-polygon (send dc draw-polygon
(list (cons (+ 15.5 (* (- R 5) (cos hour-θ))) (list (cons (+ 15.5 (* (- R 5) (cos hour-θ)))
(+ 15.5 (* (- R 5) (sin hour-θ)))) (+ 15.5 (* (- R 5) (sin hour-θ))))
(cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 1/2 pi))))) (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 1/2 pi)))))
(+ 15.5 (* 1.25 (sin (+ hour-θ (* 1/2 pi)))))) (+ 15.5 (* 1.25 (sin (+ hour-θ (* 1/2 pi))))))
(cons (+ 15.5 (* 1.25 (cos (+ hour-θ pi)))) (cons (+ 15.5 (* 1.25 (cos (+ hour-θ pi))))
(+ 15.5 (* 1.25 (sin (+ hour-θ pi))))) (+ 15.5 (* 1.25 (sin (+ hour-θ pi)))))
(cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 3/2 pi))))) (cons (+ 15.5 (* 1.25 (cos (+ hour-θ (* 3/2 pi)))))
(+ 15.5 (* 1.25 (sin (+ hour-θ (* 3/2 pi))))))))) (+ 15.5 (* 1.25 (sin (+ hour-θ (* 3/2 pi)))))))))
scale 32 32 scale metal-icon-material)))
metal-icon-material)))
(define shell-fm (define shell-fm
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc "white" 1 'solid) (set-icon-pen dc "white" 1 'solid)
(send dc set-brush "white" 'solid) (send dc set-brush "white" 'solid)
(send dc draw-ellipse 1 1 29 29)) (send dc draw-ellipse 1 1 29 29))
scale)) 32 32 scale))
(let* ([dfm (flomap->deep-flomap shell-fm)] (let* ([dfm (flomap->deep-flomap shell-fm)]
[dfm (deep-flomap-bulge-spheroid dfm (* 9 scale))] [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 clock-fm (clock-flomap (* 30/32 height) face-color hand-color hours minutes))
(define buttons-fm (define buttons-fm
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 8 (λ (dc) (λ (dc)
(set-icon-pen dc (make-object color% 128 0 0) 1 'solid) (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 set-brush (make-object color% 144 0 0) 'solid)
(send dc draw-polygon '((2 . 4) (4 . 2) (31 . 31))) (send dc draw-polygon '((2 . 4) (4 . 2) (31 . 31)))
(send dc draw-polygon '((0 . 5) (5 . 0) (6 . 1) (1 . 6))) (send dc draw-polygon '((0 . 5) (5 . 0) (6 . 1) (1 . 6)))
(set-icon-pen dc "black" 1 'solid) (set-icon-pen dc "black" 1 'solid)
(send dc set-brush (make-object color% 16 16 16) '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 '((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)))) (send dc draw-polygon '((31 . 5) (26 . 0) (24.5 . 1.5) (29.5 . 6.5))))
(/ height 32) 32 8 (/ height 32) metal-icon-material))
metal-icon-material))
(flomap-pin* 1/2 0 1/2 -2/32 buttons-fm clock-fm))) (flomap-pin* 1/2 0 1/2 -2/32 buttons-fm clock-fm)))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
@ -410,33 +406,31 @@
(define scale (/ height 32)) (define scale (/ height 32))
(flomap-ct-superimpose (flomap-ct-superimpose
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen (make-object pen% color 2 'solid 'round 'round)) (send dc set-pen (make-object pen% color 2 'solid 'round 'round))
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(draw-path-commands dc rubber-hose-commands 0 0) (draw-path-commands dc rubber-hose-commands 0 0)
(draw-path-commands dc rubber-t-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 set-pen (make-object pen% "black" 3 'solid 'round 'round))
(send dc draw-line 23.5 1 25 1.5) (send dc draw-line 23.5 1 25 1.5)
(send dc draw-line 7.5 1 6 1.5)) (send dc draw-line 7.5 1 6 1.5))
scale 32 32 scale rubber-material)
rubber-material)
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round))
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(draw-path-commands dc left-metal-commands 0 0) (draw-path-commands dc left-metal-commands 0 0)
(draw-path-commands dc right-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)) (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 left-metal-commands 0 0)
(draw-path-commands dc right-metal-commands 0 0) (draw-path-commands dc right-metal-commands 0 0)
(set-icon-pen dc dark-metal-icon-color 0.5 'solid) (set-icon-pen dc dark-metal-icon-color 0.5 'solid)
(send dc set-brush metal-icon-color 'solid) (send dc set-brush metal-icon-color 'solid)
(send dc draw-ellipse 21.25 21.25 10 10) (send dc draw-ellipse 21.25 21.25 10 10)
(set-icon-pen dc dark-metal-icon-color 0.25 'solid) (set-icon-pen dc dark-metal-icon-color 0.25 'solid)
(send dc set-brush light-metal-icon-color 'solid) (send dc set-brush light-metal-icon-color 'solid)
(send dc draw-ellipse 22.25 22.25 8 8)) (send dc draw-ellipse 22.25 22.25 8 8))
scale 32 32 scale metal-icon-material)))
metal-icon-material)))
(define short-rubber-t-commands (define short-rubber-t-commands
'((m 3 12.5) '((m 3 12.5)
@ -455,36 +449,33 @@
(define scale (/ height 32)) (define scale (/ height 32))
(flomap-ct-superimpose (flomap-ct-superimpose
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc translate 0 6) (send dc translate 0 6)
(send dc set-pen (make-object pen% color 2 'solid 'round 'round)) (send dc set-pen (make-object pen% color 2 'solid 'round 'round))
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(draw-path-commands dc short-rubber-hose-commands 0 0) (draw-path-commands dc short-rubber-hose-commands 0 0)
(draw-path-commands dc short-rubber-t-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 set-pen (make-object pen% "black" 3 'solid 'round 'round))
(send dc draw-line 4.5 1 3 1.5) (send dc draw-line 4.5 1 3 1.5)
(send dc draw-line 26.5 1 28 1.5)) (send dc draw-line 26.5 1 28 1.5))
scale 32 32 scale rubber-material)
rubber-material)
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc translate 0 6) (send dc translate 0 6)
(send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round)) (send dc set-pen (make-object pen% dark-metal-icon-color 2.5 'solid 'round 'round))
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(draw-path-commands dc left-metal-commands -3 0) (draw-path-commands dc left-metal-commands -3 0)
(draw-path-commands dc right-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)) (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 left-metal-commands -3 0)
(draw-path-commands dc right-metal-commands 3 0) (draw-path-commands dc right-metal-commands 3 0)
(set-icon-pen dc dark-metal-icon-color 0.5 'solid) (set-icon-pen dc dark-metal-icon-color 0.5 'solid)
(send dc set-brush metal-icon-color 'solid) (send dc set-brush metal-icon-color 'solid)
(send dc draw-ellipse 21.25 15.25 10 10) (send dc draw-ellipse 21.25 15.25 10 10)
(set-icon-pen dc dark-metal-icon-color 0.25 'solid) (set-icon-pen dc dark-metal-icon-color 0.25 'solid)
(send dc set-brush light-metal-icon-color 'solid) (send dc set-brush light-metal-icon-color 'solid)
(send dc draw-ellipse 22.25 16.25 8 8) (send dc draw-ellipse 22.25 16.25 8 8))
) 32 32 scale metal-icon-material)))
scale
metal-icon-material)))
;; =================================================================================================== ;; ===================================================================================================
;; Bitmaps (icons) ;; Bitmaps (icons)

149
collects/images/icons/stickman.rkt
View File

@ -120,66 +120,62 @@
[height color arm-color head-color material] [height color arm-color head-color material]
(flomap-lt-superimpose (flomap-lt-superimpose
(draw-short-rendered-icon-flomap (draw-short-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(send dc set-pen (icon-color->outline-color arm-color) (send dc set-pen (icon-color->outline-color arm-color)
(+ arm-width (* 2 line-width)) 'solid) (+ arm-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-right-shoulder-point (send dc draw-lines (list standing-right-shoulder-point
standing-right-elbow-point standing-right-elbow-point
standing-right-hand-point)) standing-right-hand-point))
(send dc set-pen arm-color arm-width 'solid) (send dc set-pen arm-color arm-width 'solid)
(send dc draw-lines (list standing-right-shoulder-point (send dc draw-lines (list standing-right-shoulder-point
standing-right-elbow-point standing-right-elbow-point
standing-right-hand-point))) standing-right-hand-point)))
(/ height 32) 26 32 (/ height 32) material)
material)
(draw-short-rendered-icon-flomap (draw-short-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(send dc set-pen (icon-color->outline-color color) (send dc set-pen (icon-color->outline-color color)
(+ body-width (* 2 line-width)) 'solid) (+ body-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-neck-point standing-hip-point)) (send dc draw-lines (list standing-neck-point standing-hip-point))
(send dc set-pen (icon-color->outline-color color) (send dc set-pen (icon-color->outline-color color)
(+ leg-width (* 2 line-width)) 'solid) (+ leg-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-hip-point (send dc draw-lines (list standing-hip-point
standing-left-knee-point standing-left-knee-point
standing-left-foot-point)) standing-left-foot-point))
(send dc draw-lines (list standing-hip-point (send dc draw-lines (list standing-hip-point
standing-right-knee-point standing-right-knee-point
standing-right-foot-point)) standing-right-foot-point))
(send dc set-pen color body-width 'solid) (send dc set-pen color body-width 'solid)
(send dc draw-lines (list standing-neck-point standing-hip-point)) (send dc draw-lines (list standing-neck-point standing-hip-point))
(send dc set-pen color leg-width 'solid) (send dc set-pen color leg-width 'solid)
(send dc draw-lines (list standing-hip-point (send dc draw-lines (list standing-hip-point
standing-left-knee-point standing-left-knee-point
standing-left-foot-point)) standing-left-foot-point))
(send dc draw-lines (list standing-hip-point (send dc draw-lines (list standing-hip-point
standing-right-knee-point standing-right-knee-point
standing-right-foot-point))) standing-right-foot-point)))
(/ height 32) 26 32 (/ height 32) material)
material)
(draw-short-rendered-icon-flomap (draw-short-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(send dc set-pen (icon-color->outline-color arm-color) (send dc set-pen (icon-color->outline-color arm-color)
(+ arm-width (* 2 line-width)) 'solid) (+ arm-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-left-shoulder-point (send dc draw-lines (list standing-left-shoulder-point
standing-left-elbow-point standing-left-elbow-point
standing-left-hand-point)) standing-left-hand-point))
(send dc set-pen arm-color arm-width 'solid) (send dc set-pen arm-color arm-width 'solid)
(send dc draw-lines (list standing-left-shoulder-point (send dc draw-lines (list standing-left-shoulder-point
standing-left-elbow-point standing-left-elbow-point
standing-left-hand-point))) standing-left-hand-point)))
(/ height 32) 26 32 (/ height 32) material)
material)
(draw-short-rendered-icon-flomap (draw-short-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(send dc set-pen (icon-color->outline-color head-color) line-width 'solid) (send dc set-pen (icon-color->outline-color head-color) line-width 'solid)
(send dc set-brush head-color 'solid) (send dc set-brush head-color 'solid)
(match-define (cons x y) standing-head-point) (match-define (cons x y) standing-head-point)
(send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7))
(/ height 32) 26 32 (/ height 32) material))))
material))))
;; =================================================================================================== ;; ===================================================================================================
;; Running ;; Running
@ -269,37 +265,34 @@
(make-cached-flomap (make-cached-flomap
[height t color material] [height t color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(send dc set-pen (icon-color->outline-color color) line-width 'solid) (send dc set-pen (icon-color->outline-color color) line-width 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(match-define (cons x y) (running-head-point t)) (match-define (cons x y) (running-head-point t))
(send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7)) (send dc draw-ellipse (- x 3.5) (- y 3.5) 7 7))
(/ height 32) 26 32 (/ height 32) material)))
material)))
(define (running-leg-flomap t body? color height material) (define (running-leg-flomap t body? color height material)
(make-cached-flomap (make-cached-flomap
[height t body? color material] [height t body? color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(draw-running-leg dc t (icon-color->outline-color color) (+ leg-width (* 2 line-width))) (draw-running-leg dc t (icon-color->outline-color color) (+ leg-width (* 2 line-width)))
(when body? (when body?
(draw-running-body dc t (icon-color->outline-color color) (draw-running-body dc t (icon-color->outline-color color)
(+ body-width (* 2 line-width))) (+ body-width (* 2 line-width)))
(draw-running-body dc t color body-width)) (draw-running-body dc t color body-width))
(draw-running-leg dc t color leg-width)) (draw-running-leg dc t color leg-width))
(/ height 32) 26 32 (/ height 32) material)))
material)))
(define (running-arm-flomap t color height material) (define (running-arm-flomap t color height material)
(make-cached-flomap (make-cached-flomap
[height t color material] [height t color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) (λ (dc)
(draw-running-arm dc t (icon-color->outline-color color) (+ arm-width (* 2 line-width))) (draw-running-arm dc t (icon-color->outline-color color) (+ arm-width (* 2 line-width)))
(draw-running-arm dc t color arm-width)) (draw-running-arm dc t color arm-width))
(/ height 32) 26 32 (/ height 32) material)))
material)))
(defproc (running-stickman-flomap [t rational?] (defproc (running-stickman-flomap [t rational?]
[color (or/c string? (is-a?/c color%))] [color (or/c string? (is-a?/c color%))]

18
collects/images/icons/style.rkt
View File

@ -123,21 +123,21 @@
[dfm (deep-flomap-raise dfm (* s height))]) [dfm (deep-flomap-raise dfm (* s height))])
dfm)) dfm))
(define (draw-icon-flomap w h draw-proc scale) (define (draw-icon-flomap draw-proc w h scale)
(draw-flomap (inexact->exact (ceiling (* w scale))) (draw-flomap (λ (dc)
(inexact->exact (ceiling (* h scale)))
(λ (dc)
(send dc set-scale scale scale) (send dc set-scale scale scale)
(send dc set-smoothing 'smoothed) (send dc set-smoothing 'smoothed)
(send dc set-origin (* 0.5 scale) (* 0.5 scale)) (send dc set-origin (* 0.5 scale) (* 0.5 scale))
(set-icon-pen dc "black" 10 'solid) (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) (define (flomap-render-icon fm material)
(deep-flomap-render-icon (deep-flomap-icon-style (flomap->deep-flomap 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) (define (draw-rendered-icon-flomap draw-proc w h scale material)
(let* ([fm (draw-icon-flomap w h draw-proc scale)] (let* ([fm (draw-icon-flomap draw-proc w h scale)]
[fm (flomap-render-icon fm material)]) [fm (flomap-render-icon fm material)])
fm)) fm))
@ -149,8 +149,8 @@
dfm)) dfm))
(deep-flomap-render-icon dfm material)) (deep-flomap-render-icon dfm material))
(define (draw-short-rendered-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 w h proc scale) material)) (flomap-render-thin-icon (draw-icon-flomap draw-proc w h scale) material))
;; =================================================================================================== ;; ===================================================================================================
;; Syntax for writing icon functions ;; Syntax for writing icon functions

94
collects/images/icons/symbol.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #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 racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt" "../private/deep-flomap.rkt"
@ -21,28 +21,28 @@
(define mn 7.5) (define mn 7.5)
(define mx 23.5) (define mx 23.5)
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen (make-object pen% (icon-color->outline-color color) (send dc set-pen (make-object pen% (icon-color->outline-color color)
12 'solid 'projecting 'miter)) 12 'solid 'projecting 'miter))
(send dc draw-line mn mn mx mx) (send dc draw-line mn mn mx mx)
(send dc draw-line mn mx mx mn) (send dc draw-line mn mx mx mn)
(send dc set-pen (make-object pen% color 10 'solid 'projecting 'miter)) (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 mn mx mx)
(send dc draw-line mn mx mx mn)) (send dc draw-line mn mx mx mn))
(/ height 32))) 32 32 (/ height 32)))
(define (flat-check-flomap color height) (define (flat-check-flomap color height)
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid) (set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc '((m 0 19) (draw-path-commands dc '((m 0 19)
(c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23) (c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23)
(l -9 -8) (l -9 -8)
(c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5) (c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5)
(l -6 9)) (l -6 9))
0 0)) 0 0))
(/ height 32))) 32 32 (/ height 32)))
(defproc (text-flomap [str string?] [font (is-a?/c font%)] (defproc (text-flomap [str string?] [font (is-a?/c font%)]
[color (or/c string? (is-a?/c color%))] [color (or/c string? (is-a?/c color%))]
@ -68,14 +68,15 @@
(define-values (w h) (get-text-size str font)) (define-values (w h) (get-text-size str font))
(define ceiling-amt (inexact->exact (ceiling outline))) (define ceiling-amt (inexact->exact (ceiling outline)))
(let* ([fm (draw-flomap (let* ([fm (draw-flomap
w h (λ (dc) (λ (dc)
(send dc set-font font) (send dc set-font font)
(send dc set-text-foreground color) (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 (if trim? (flomap-trim fm) fm)]
[fm (flomap-resize fm #f (- height (* 2 ceiling-amt)))] [fm (flomap-resize fm #f (- height (* 2 ceiling-amt)))]
[fm (flomap-inset fm 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))))) (flomap-render-icon fm material)))))
(define recycle-path-commands (define recycle-path-commands
@ -135,12 +136,11 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-short-rendered-icon-flomap (draw-short-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1/2 'solid) (set-icon-pen dc (icon-color->outline-color color) 1/2 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc recycle-path-commands 0 0)) (draw-path-commands dc recycle-path-commands 0 0))
(/ height 32) 32 32 (/ height 32) material)))
material)))
(defproc (x-flomap [color (or/c string? (is-a?/c color%))] (defproc (x-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -229,15 +229,14 @@
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 4 'solid) (set-icon-pen dc (icon-color->outline-color color) 4 'solid)
(send dc set-brush (icon-color->outline-color color) 'solid) (send dc set-brush (icon-color->outline-color color) 'solid)
(draw-path-commands dc lambda-path-commands 4 0) (draw-path-commands dc lambda-path-commands 4 0)
(set-icon-pen dc color 2 'solid) (set-icon-pen dc color 2 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc lambda-path-commands 4 0)) (draw-path-commands dc lambda-path-commands 4 0))
(/ height 32) 32 32 (/ height 32) material)))
material)))
(defproc (hash-quote-flomap [color (or/c string? (is-a?/c color%))] (defproc (hash-quote-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)] [height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -257,16 +256,15 @@
(define outline-color (icon-color->outline-color color)) (define outline-color (icon-color->outline-color color))
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
36 32 (λ (dc) (λ (dc)
(send dc translate 0.5 0.5) (send dc translate 0.5 0.5)
(set-icon-pen dc outline-color 2 'solid) (set-icon-pen dc outline-color 2 'solid)
(send dc set-brush outline-color 'solid) (send dc set-brush outline-color 'solid)
(draw-hash-quote dc) (draw-hash-quote dc)
(send dc set-pen "black" 1 'transparent) (send dc set-pen "black" 1 'transparent)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-hash-quote dc)) (draw-hash-quote dc))
(/ height 32) 36 32 (/ height 32) material)))
material)))
;; =================================================================================================== ;; ===================================================================================================
;; Bitmaps (icons) ;; Bitmaps (icons)

140
collects/images/logos.rkt
View File

@ -116,26 +116,26 @@
(define scale (/ height 256)) (define scale (/ height 256))
(define bulge-fm (define bulge-fm
(draw-icon-flomap (draw-icon-flomap
256 256 (λ (dc) (λ (dc)
(send dc set-pen logo-red-color 2 'transparent) (send dc set-pen logo-red-color 2 'transparent)
(send dc set-brush logo-red-color 'solid) (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 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-pen logo-blue-color 2 'transparent)
(send dc set-brush logo-blue-color 'solid) (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 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-pen (lambda-pen lambda-outline-color 10))
(send dc set-brush lambda-outline-color 'solid) (send dc set-brush lambda-outline-color 'solid)
(draw-lambda dc 8 8 240 240)) (draw-lambda dc 8 8 240 240))
scale)) 256 256 scale))
(define (lambda-flomap color pen-width) (define (lambda-flomap color pen-width)
(draw-icon-flomap (draw-icon-flomap
256 256 (λ (dc) (λ (dc)
(send dc set-scale scale scale) (send dc set-scale scale scale)
(send dc set-pen (lambda-pen color pen-width)) (send dc set-pen (lambda-pen color pen-width))
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-lambda dc 8 8 240 240)) (draw-lambda dc 8 8 240 240))
scale)) 256 256 scale))
(let* ([bulge-dfm (flomap->deep-flomap bulge-fm)] (let* ([bulge-dfm (flomap->deep-flomap bulge-fm)]
[bulge-dfm (deep-flomap-bulge-spheroid bulge-dfm (* 112 scale))] [bulge-dfm (deep-flomap-bulge-spheroid bulge-dfm (* 112 scale))]
@ -150,14 +150,14 @@
lambda-fm)] lambda-fm)]
[fm (flomap-cc-superimpose [fm (flomap-cc-superimpose
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen lambda-outline-color 1/2 'solid) (send dc set-pen lambda-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid) (send dc set-brush "white" 'solid)
(send dc draw-ellipse -0.25 -0.25 31.5 31.5) (send dc draw-ellipse -0.25 -0.25 31.5 31.5)
(send dc set-pen "lightblue" 1/2 'solid) (send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 30 30)) (send dc draw-ellipse 0.5 0.5 30 30))
(/ height 32)) 32 32 (/ height 32))
fm)]) fm)])
fm))) fm)))
@ -252,11 +252,11 @@
(define (continents-flomap color height) (define (continents-flomap color height)
(define scale (/ height 32)) (define scale (/ height 32))
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen lambda-outline-color 3/8 'solid) (send dc set-pen lambda-outline-color 3/8 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc continents-path-commands 0 -17)) (draw-path-commands dc continents-path-commands 0 -17))
scale)) 32 32 scale))
(defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap? (defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(make-cached-flomap (make-cached-flomap
@ -268,11 +268,11 @@
[indent-dfm (deep-flomap-raise indent-dfm (* -1/8 scale))] [indent-dfm (deep-flomap-raise indent-dfm (* -1/8 scale))]
[indent-dfm (deep-flomap-smooth-z indent-dfm (* 1 scale))] [indent-dfm (deep-flomap-smooth-z indent-dfm (* 1 scale))]
[earth-fm (draw-icon-flomap [earth-fm (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen logo-water-color 1/2 'solid) (send dc set-pen logo-water-color 1/2 'solid)
(send dc set-brush logo-water-color 'solid) (send dc set-brush logo-water-color 'solid)
(send dc draw-ellipse 0.75 0.75 29.5 29.5)) (send dc draw-ellipse 0.75 0.75 29.5 29.5))
scale)] 32 32 scale)]
[earth-dfm (flomap->deep-flomap earth-fm)] [earth-dfm (flomap->deep-flomap earth-fm)]
[earth-dfm (deep-flomap-bulge-spheroid earth-dfm (* 16 scale))] [earth-dfm (deep-flomap-bulge-spheroid earth-dfm (* 16 scale))]
[earth-dfm (deep-flomap-cc-superimpose 'add earth-dfm indent-dfm)]) [earth-dfm (deep-flomap-cc-superimpose 'add earth-dfm indent-dfm)])
@ -288,14 +288,14 @@
(flomap-cc-superimpose (flomap-cc-superimpose
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen lambda-outline-color 1/2 'solid) (send dc set-pen lambda-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid) (send dc set-brush "white" 'solid)
(send dc draw-ellipse -0.25 -0.25 31.5 31.5) (send dc draw-ellipse -0.25 -0.25 31.5 31.5)
(send dc set-pen "lightblue" 1/2 'solid) (send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 30 30)) (send dc draw-ellipse 0.5 0.5 30 30))
scale) 32 32 scale)
earth-fm earth-fm
land-fm))) land-fm)))
@ -338,11 +338,11 @@
(define (racket-r-flomap color height) (define (racket-r-flomap color height)
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(set-icon-pen dc racket-r-outline-color 3/8 'solid) (set-icon-pen dc racket-r-outline-color 3/8 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(draw-path-commands dc racket-r-commands 0 0)) (draw-path-commands dc racket-r-commands 0 0))
(/ height 32))) 32 32 (/ height 32)))
(define racket-sphere-material (define racket-sphere-material
(deep-flomap-material-value (deep-flomap-material-value
@ -361,20 +361,20 @@
[indent-dfm (deep-flomap-raise indent-dfm (* -0.75 scale))] [indent-dfm (deep-flomap-raise indent-dfm (* -0.75 scale))]
[indent-dfm (deep-flomap-smooth-z indent-dfm (* 0.5 scale))] [indent-dfm (deep-flomap-smooth-z indent-dfm (* 0.5 scale))]
[sphere-fm (draw-icon-flomap [sphere-fm (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(define top-rgn (make-object region% dc)) (define top-rgn (make-object region% dc))
(send top-rgn set-polygon (send top-rgn set-polygon
'((0 . 0) (31 . 0) (31 . 4) (5 . 13) (8 . 31) (0 . 31))) '((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-pen logo-blue-color 1/2 'solid)
(send dc set-brush logo-blue-color 'solid) (send dc set-brush logo-blue-color 'solid)
(send dc draw-ellipse 0.75 0.75 29.5 29.5) (send dc draw-ellipse 0.75 0.75 29.5 29.5)
(send dc set-clipping-region top-rgn) (send dc set-clipping-region top-rgn)
(send dc set-pen logo-red-color 1/2 'solid) (send dc set-pen logo-red-color 1/2 'solid)
(send dc set-brush logo-red-color 'solid) (send dc set-brush logo-red-color 'solid)
(send dc draw-ellipse 0.75 0.75 29.5 29.5)) (send dc draw-ellipse 0.75 0.75 29.5 29.5))
scale)] 32 32 scale)]
[sphere-dfm (flomap->deep-flomap sphere-fm)] [sphere-dfm (flomap->deep-flomap sphere-fm)]
[sphere-dfm (deep-flomap-bulge-spheroid sphere-dfm (* 14 scale))] [sphere-dfm (deep-flomap-bulge-spheroid sphere-dfm (* 14 scale))]
[sphere-dfm (deep-flomap-cc-superimpose 'add sphere-dfm indent-dfm)]) [sphere-dfm (deep-flomap-cc-superimpose 'add sphere-dfm indent-dfm)])
@ -389,14 +389,14 @@
(flomap-cc-superimpose (flomap-cc-superimpose
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) (λ (dc)
(send dc set-pen racket-r-outline-color 1/2 'solid) (send dc set-pen racket-r-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid) (send dc set-brush "white" 'solid)
(send dc draw-ellipse -0.25 -0.25 31.5 31.5) (send dc draw-ellipse -0.25 -0.25 31.5 31.5)
(send dc set-pen "lightblue" 1/2 'solid) (send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent) (send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 30 30)) (send dc draw-ellipse 0.5 0.5 30 30))
scale) 32 32 scale)
sphere-fm sphere-fm
r-fm))) r-fm)))

11
collects/images/private/draw-predicates.rkt
View File

@ -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<%>))

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

@ -21,11 +21,12 @@
(flomap-gaussian-blur-y (flomap-gaussian-blur-x fm (abs (exact->inexact xσ))) (flomap-gaussian-blur-y (flomap-gaussian-blur-x fm (abs (exact->inexact xσ)))
(abs (exact->inexact yσ)))])) (abs (exact->inexact yσ)))]))
(: flomap-gaussian-blur-x (flomap Flonum -> flomap)) (: flomap-gaussian-blur-x (flomap Real -> flomap))
(define (flomap-gaussian-blur-x fm σ) (define (flomap-gaussian-blur-x fm σ*)
(cond (cond
[(σ . = . 0.0) fm] [(σ* . = . 0) fm]
[else [else
(define σ (abs (exact->inexact σ*)))
(define dx-min (fl->fx (floor (* (- 3.0) σ)))) (define dx-min (fl->fx (floor (* (- 3.0) σ))))
(define dx-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ))))) (define dx-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ)))))
(define ss (gaussian-kernel-1d dx-min dx-max σ)) (define ss (gaussian-kernel-1d dx-min dx-max σ))
@ -44,11 +45,12 @@
(fx+ j c))] (fx+ j c))]
[else sum]))))])) [else sum]))))]))
(: flomap-gaussian-blur-y (flomap Flonum -> flomap)) (: flomap-gaussian-blur-y (flomap Real -> flomap))
(define (flomap-gaussian-blur-y fm σ) (define (flomap-gaussian-blur-y fm σ*)
(cond (cond
[(σ . = . 0.0) fm] [(σ* . = . 0) fm]
[else [else
(define σ (abs (exact->inexact σ*)))
(define dy-min (fl->fx (floor (* (- 3.0) σ)))) (define dy-min (fl->fx (floor (* (- 3.0) σ))))
(define dy-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ))))) (define dy-max (fx+ 1 (fl->fx (ceiling (* 3.0 σ)))))
(define ss (gaussian-kernel-1d dy-min dy-max σ)) (define ss (gaussian-kernel-1d dy-min dy-max σ))
@ -203,8 +205,9 @@
[else [else
(flomap-box-blur-y (flomap-box-blur-x fm xr) yr)]))])) (flomap-box-blur-y (flomap-box-blur-x fm xr) yr)]))]))
(: flomap-box-blur-x (flomap Flonum -> flomap)) (: flomap-box-blur-x (flomap Real -> flomap))
(define (flomap-box-blur-x fm r) (define (flomap-box-blur-x fm r*)
(define r (abs (exact->inexact r*)))
(cond (cond
[(integer? r) (let ([r (fl->fx r)]) [(integer? r) (let ([r (fl->fx r)])
(with-asserts ([r nonnegative-fixnum?]) (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)) (* 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)) (: flomap-box-blur-y (flomap Real -> flomap))
(define (flomap-box-blur-y fm r) (define (flomap-box-blur-y fm r*)
(define r (abs (exact->inexact r*)))
(cond (cond
[(integer? r) (let ([r (fl->fx r)]) [(integer? r) (let ([r (fl->fx r)])
(with-asserts ([r nonnegative-fixnum?]) (with-asserts ([r nonnegative-fixnum?])

147
collects/images/private/flomap-composite.rkt
View File

@ -1,6 +1,6 @@
#lang typed/racket/base #lang typed/racket/base
(require racket/match (require racket/match racket/unsafe/ops
"flonum.rkt" "flonum.rkt"
"flomap-struct.rkt") "flomap-struct.rkt")
@ -11,62 +11,99 @@
flomap-vl-append flomap-vc-append flomap-vr-append flomap-vl-append flomap-vc-append flomap-vr-append
flomap-ht-append flomap-hc-append flomap-hb-append) flomap-ht-append flomap-hc-append flomap-hb-append)
(: flomap-pin (flomap Real Real flomap Real Real -> flomap)) (: flomap-pin (case-> (flomap Integer Integer flomap -> flomap)
(define (flomap-pin fm1 x1 y1 fm2 x2 y2) (flomap Integer Integer flomap Integer Integer -> flomap)))
(cond (define flomap-pin
[(not (and (zero? x2) (zero? y2))) (case-lambda
(flomap-pin fm1 (- x1 x2) (- y1 y2) fm2 0 0)] [(fm1 x1 y1 fm2)
[else (match-define (flomap argb1-vs c w1 h1) fm1)
(let ([x1 (exact->inexact x1)] [y1 (exact->inexact y1)]) (match-define (flomap argb2-vs c2 w2 h2) fm2)
(match-define (flomap argb1-vs 4 w1 h1) fm1)
(match-define (flomap argb2-vs 4 w2 h2) fm2) (unless (c . > . 0)
(raise-type-error 'flomap-pin "flomap with at least one component" fm1))
;; fm1 and fm2 offsets, in final image coordinates
(define dx1 (fl->fx (round (max 0.0 (- x1))))) (unless (= c c2)
(define dy1 (fl->fx (round (max 0.0 (- y1))))) (error 'flomap-pin
(define dx2 (fl->fx (round (max 0.0 x1)))) (string-append "expected two flomaps with the same number of components; "
(define dy2 (fl->fx (round (max 0.0 y1)))) "given one with ~e and one with ~e")
c c2))
;; final image size
(define w (fxmax (fx+ dx1 w1) (fx+ dx2 w2))) ;; fm1 and fm2 offsets, in final image coordinates
(define h (fxmax (fx+ dy1 h1) (fx+ dy2 h2))) (define dx1 (fxmax 0 (fx- 0 x1)))
(define dy1 (fxmax 0 (fx- 0 y1)))
(: get-argb-pixel (FlVector Integer Integer Integer Integer Integer Integer (define dx2 (fxmax 0 x1))
-> (values Flonum Flonum Flonum Flonum))) (define dy2 (fxmax 0 y1))
(define (get-argb-pixel argb-vs dx dy w h x y)
(let ([x (fx- x dx)] [y (fx- y dy)]) ;; final image size
(cond [(and (x . fx>= . 0) (x . fx< . w) (y . fx>= . 0) (y . fx< . h)) (define w (fxmax (unsafe-fx+ dx1 w1) (unsafe-fx+ dx2 w2)))
(define i (coords->index 4 w 0 x y)) (define h (fxmax (unsafe-fx+ dy1 h1) (unsafe-fx+ dy2 h2)))
(values (flvector-ref argb-vs i)
(flvector-ref argb-vs (fx+ i 1)) (define argb-vs (make-flvector (* c w h)))
(flvector-ref argb-vs (fx+ i 2)) (let: y-loop : Void ([y : Nonnegative-Fixnum 0])
(flvector-ref argb-vs (fx+ i 3)))] (when (y . fx< . h)
[else (values 0.0 0.0 0.0 0.0)]))) (define y1 (unsafe-fx- y dy1))
(define y2 (unsafe-fx- y dy2))
(define argb-vs (make-flvector (* 4 w h))) (let: x-loop : Void ([x : Nonnegative-Fixnum 0])
(let: y-loop : Void ([y : Nonnegative-Fixnum 0]) (cond
(when (y . fx< . h) [(x . fx< . w)
(let: x-loop : Void ([x : Nonnegative-Fixnum 0]) (define x1 (unsafe-fx- x dx1))
(cond (define x2 (unsafe-fx- x dx2))
[(x . fx< . w)
(define-values (a1 r1 g1 b1) (get-argb-pixel argb1-vs dx1 dy1 w1 h1 x y)) (define i (coords->index c w 0 x y))
(define-values (a2 r2 g2 b2) (get-argb-pixel argb2-vs dx2 dy2 w2 h2 x y)) (define-values (i1 a1)
(define i (coords->index 4 w 0 x y)) (cond [(and (x1 . fx>= . 0) (x1 . fx< . w1) (y1 . fx>= . 0) (y1 . fx< . h1))
(flvector-set! argb-vs i (fl-alpha-blend a1 a2 a2)) (define i1 (coords->index c w1 0 x1 y1))
(flvector-set! argb-vs (fx+ i 1) (fl-alpha-blend r1 r2 a2)) (values i1 (flvector-ref argb1-vs i1))]
(flvector-set! argb-vs (fx+ i 2) (fl-alpha-blend g1 g2 a2)) [else (values 0 0.0)]))
(flvector-set! argb-vs (fx+ i 3) (fl-alpha-blend b1 b2 a2)) (define-values (i2 a2)
(x-loop (fx+ x 1))] (cond [(and (x2 . fx>= . 0) (x2 . fx< . w2) (y2 . fx>= . 0) (y2 . fx< . h2))
[else (y-loop (fx+ y 1))])))) (define i2 (coords->index c w2 0 x2 y2))
(flomap argb-vs 4 w h))])) (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)) (: flomap-pin* (Real Real Real Real flomap flomap * -> flomap))
(define (flomap-pin* x1-frac y1-frac x2-frac y2-frac fm . fms) (define (flomap-pin* x1-frac y1-frac x2-frac y2-frac fm0 . fms)
(for/fold ([fm1 fm]) ([fm2 (in-list fms)]) (define-values (fm _x _y)
(define-values (w1 h1) (flomap-size fm1)) (for/fold: ([fm : flomap fm0]
(define-values (w2 h2) (flomap-size fm2)) [x : Exact-Rational 0]
(flomap-pin fm1 (* x1-frac w1) (* y1-frac h1) [y : Exact-Rational 0]
fm2 (* x2-frac w2) (* y2-frac h2)))) ) ([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-lt-superimpose (flomap flomap * -> flomap))
(: flomap-lc-superimpose (flomap flomap * -> flomap)) (: flomap-lc-superimpose (flomap flomap * -> flomap))

4
collects/images/private/flomap-convert.rkt
View File

@ -15,6 +15,8 @@
[else 0.0]))) [else 0.0])))
(define (bitmap->flomap bm) (define (bitmap->flomap bm)
(unless (is-a? bm bitmap%)
(raise-type-error 'bitmap->flomap "bitmap% instance" bm))
(define w (send bm get-width)) (define w (send bm get-width))
(define h (send bm get-height)) (define h (send bm get-height))
(define bs (make-bytes (* 4 w h))) (define bs (make-bytes (* 4 w h)))
@ -72,7 +74,7 @@
(send bm set-argb-pixels 0 0 w h bs #f #t) (send bm set-argb-pixels 0 0 w h bs #f #t)
bm)) 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 (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)) (unless (h . >= . 0) (raise-type-error 'draw-flomap "nonnegative fixnum" 1 w h draw-proc))

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

@ -13,13 +13,13 @@
flomap-shadow flomap-shadowed flomap-shadow flomap-shadowed
flomap-whirl-morph) flomap-whirl-morph)
(: colorize-alpha (flomap (Listof Real) -> flomap)) (: colorize-alpha (flomap FlVector -> flomap))
(define (colorize-alpha fm color) (define (colorize-alpha fm vs)
(match-define (flomap _ 1 w h) fm) (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-shadow (case-> (flomap Real -> flomap)
(flomap Real (Option (Listof Real)) -> flomap))) (flomap Real (Option FlVector) -> flomap)))
(define flomap-shadow (define flomap-shadow
(case-lambda (case-lambda
[(fm σ) (flomap-shadow fm σ #f)] [(fm σ) (flomap-shadow fm σ #f)]
@ -27,18 +27,18 @@
(match-define (flomap _ c w h) fm) (match-define (flomap _ c w h) fm)
(cond [(c . = . 0) fm] (cond [(c . = . 0) fm]
[else (define alpha-fm (flomap-ref-component fm 0)) [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)])])) (colorize-alpha (flomap-blur alpha-fm σ) color-vs)])]))
(: flomap-shadowed (case-> (flomap Real -> flomap) (: flomap-shadowed (case-> (flomap Real -> flomap)
(flomap Real (Option (Listof Real)) -> flomap))) (flomap Real (Option FlVector) -> flomap)))
(define flomap-shadowed (define flomap-shadowed
(case-lambda (case-lambda
[(fm σ) (flomap-shadowed fm σ #f)] [(fm σ) (flomap-shadowed fm σ #f)]
[(fm σ c) (flomap-cc-superimpose (flomap-shadow fm σ c) fm)])) [(fm σ c) (flomap-cc-superimpose (flomap-shadow fm σ c) fm)]))
(: flomap-outline (case-> (flomap Real -> flomap) (: flomap-outline (case-> (flomap Real -> flomap)
(flomap Real (Option (Listof Real)) -> flomap))) (flomap Real (Option FlVector) -> flomap)))
(define flomap-outline (define flomap-outline
(case-lambda (case-lambda
[(fm amt) (flomap-outline fm amt #f)] [(fm amt) (flomap-outline fm amt #f)]
@ -57,11 +57,11 @@
(define alpha-fm (flomap-ref-component fm 0)) (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) (define new-alpha-fm (fmmax 0.0 (fmmin 1.0 (fm/ (fm- (flomap-blur alpha-fm σ) v-min)
(- v-max 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))])) (colorize-alpha new-alpha-fm color-vs))]))
(: flomap-outlined (case-> (flomap Real -> flomap) (: flomap-outlined (case-> (flomap Real -> flomap)
(flomap Real (Option (Listof Real)) -> flomap))) (flomap Real (Option FlVector) -> flomap)))
(define flomap-outlined (define flomap-outlined
(case-lambda (case-lambda
[(fm amt) (flomap-outlined fm amt #f)] [(fm amt) (flomap-outlined fm amt #f)]

4
collects/images/private/flomap-gradient.rkt
View File

@ -8,7 +8,7 @@
(provide flomap-gradient-x flomap-gradient-y flomap-gradient flomap-gradient-normal) (provide flomap-gradient-x flomap-gradient-y flomap-gradient flomap-gradient-normal)
;; =================================================================================================== ;; ===================================================================================================
;; Derivatives (Schurr operator) ;; Derivatives (Scharr operator)
(: flomap-gradient-x (flomap -> flomap)) (: flomap-gradient-x (flomap -> flomap))
(define (flomap-gradient-x fm) (define (flomap-gradient-x fm)
@ -70,6 +70,8 @@
(: flomap-gradient-normal (flomap -> flomap)) (: flomap-gradient-normal (flomap -> flomap))
(define (flomap-gradient-normal z-fm) (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)) (define-values (dx-fm dy-fm) (flomap-gradient z-fm))
(match-define (flomap dx-vs 1 w h) dx-fm) (match-define (flomap dx-vs 1 w h) dx-fm)
(match-define (flomap dy-vs 1 _w _h) dy-fm) (match-define (flomap dy-vs 1 _w _h) dy-fm)

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

@ -6,7 +6,7 @@
"flomap-stats.rkt") "flomap-stats.rkt")
(provide flomap-lift flomap-lift2 inline-flomap-lift inline-flomap-lift2 (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) flomap-normalize flomap-multiply-alpha flomap-divide-alpha)
;; =================================================================================================== ;; ===================================================================================================
@ -90,6 +90,9 @@
(define fmmin (inline-flomap-lift2 'fmmin min)) (define fmmin (inline-flomap-lift2 'fmmin min))
(define fmmax (inline-flomap-lift2 'fmmax max)) (define fmmax (inline-flomap-lift2 'fmmax max))
(: fmsqr (flomap -> flomap))
(define (fmsqr fm) (fm* fm fm))
(: flomap-normalize (flomap -> flomap)) (: flomap-normalize (flomap -> flomap))
(define (flomap-normalize fm) (define (flomap-normalize fm)
(define-values (v-min v-max) (flomap-extreme-values fm)) (define-values (v-min v-max) (flomap-extreme-values fm))

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

@ -7,12 +7,56 @@
"flomap-stats.rkt" "flomap-stats.rkt"
"flomap-blur.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-lt-crop flomap-lc-crop flomap-lb-crop
flomap-ct-crop flomap-cc-crop flomap-cb-crop flomap-ct-crop flomap-cc-crop flomap-cb-crop
flomap-rt-crop flomap-rc-crop flomap-rb-crop flomap-rt-crop flomap-rc-crop flomap-rb-crop
flomap-scale flomap-resize) 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-inset (case-> (flomap Integer -> flomap)
(flomap Integer Integer -> flomap) (flomap Integer Integer -> flomap)
(flomap Integer Integer Integer Integer -> flomap))) (flomap Integer Integer Integer Integer -> flomap)))
@ -21,41 +65,8 @@
[(fm amt) (flomap-inset fm amt amt amt amt)] [(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 h-amt v-amt) (flomap-inset fm h-amt v-amt h-amt v-amt)]
[(fm l-amt t-amt r-amt b-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] (match-define (flomap _ _ w h) fm)
[else (subflomap fm (- l-amt) (- t-amt) (+ w r-amt) (+ h b-amt))]))
(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))]))
(: flomap-crop (flomap Integer Integer Real Real -> flomap)) (: flomap-crop (flomap Integer Integer Real Real -> flomap))
(define (flomap-crop fm width height x-frac y-frac) (define (flomap-crop fm width height x-frac y-frac)
@ -128,14 +139,14 @@
(: flomap-scale-x (flomap Flonum -> flomap)) (: flomap-scale-x (flomap Flonum -> flomap))
(define (flomap-scale-x fm scale) (define (flomap-scale-x fm scale)
(match-define (flomap _ c w h) fm) (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)]) [else (let ([scale (abs scale)])
(flomap-scale*-x fm scale (abs (fl->fx (ceiling (* (exact->inexact w) scale))))))])) (flomap-scale*-x fm scale (abs (fl->fx (ceiling (* (exact->inexact w) scale))))))]))
(: flomap-scale-y (flomap Flonum -> flomap)) (: flomap-scale-y (flomap Flonum -> flomap))
(define (flomap-scale-y fm scale) (define (flomap-scale-y fm scale)
(match-define (flomap _ c w h) fm) (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)]) [else (let ([scale (abs scale)])
(flomap-scale*-y fm scale (abs (fl->fx (ceiling (* (exact->inexact h) scale))))))])) (flomap-scale*-y fm scale (abs (fl->fx (ceiling (* (exact->inexact h) scale))))))]))

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

@ -9,9 +9,9 @@
(provide flomap flomap? flomap-values flomap-components flomap-width flomap-height (provide flomap flomap? flomap-values flomap-components flomap-width flomap-height
;; Accessors ;; Accessors
flomap-size flomap-ref flomap-bilinear-ref coords->index flomap-size unsafe-flomap-ref flomap-ref flomap-bilinear-ref coords->index
;; Basic constructors ;; 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) flomap-ref-component flomap-take-components flomap-drop-components flomap-append-components)
(struct: flomap ([values : FlVector] [components : Integer] [width : Integer] [height : Integer]) (struct: flomap ([values : FlVector] [components : Integer] [width : Integer] [height : Integer])
@ -120,11 +120,10 @@
(define (build-flomap components width height fun) (define (build-flomap components width height fun)
(inline-build-flomap components width height (λ (k x y i) (exact->inexact (fun k x y i))))) (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)) (: make-flomap* (Integer Integer FlVector -> flomap))
(define (make-flomap/components w h vs) (define (make-flomap* w h vs)
(let ([vs (apply flvector (map exact->inexact vs))]) (define c (flvector-length vs))
(define c (flvector-length vs)) (inline-build-flomap c w h (λ (k _x _y _i) (unsafe-flvector-ref vs k))))
(inline-build-flomap c w h (λ (k _x _y _i) (unsafe-flvector-ref vs k)))))
(: flomap-ref-component (flomap Integer -> flomap)) (: flomap-ref-component (flomap Integer -> flomap))
(define (flomap-ref-component fm k) (define (flomap-ref-component fm k)

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

@ -10,16 +10,11 @@
"flomap-composite.rkt" "flomap-composite.rkt"
"flomap-resize.rkt") "flomap-resize.rkt")
(require/typed
"draw-predicates.rkt"
[opaque Bitmap bitmap?]
[opaque DC dc?])
(require/typed (require/typed
"flomap-convert.rkt" "flomap-convert.rkt"
[bitmap->flomap (Bitmap -> flomap)] [bitmap->flomap (Any -> flomap)]
[flomap->bitmap (flomap -> Bitmap)] [flomap->bitmap (flomap -> Any)]
[draw-flomap (Integer Integer (DC -> Any) -> flomap)]) [draw-flomap ((Any -> Any) Integer Integer -> flomap)])
(provide (all-from-out "flomap-struct.rkt" (provide (all-from-out "flomap-struct.rkt"
"flomap-stats.rkt" "flomap-stats.rkt"
@ -30,5 +25,4 @@
"flomap-blur.rkt" "flomap-blur.rkt"
"flomap-composite.rkt" "flomap-composite.rkt"
"flomap-resize.rkt") "flomap-resize.rkt")
Bitmap DC
bitmap->flomap flomap->bitmap draw-flomap) bitmap->flomap flomap->bitmap draw-flomap)

817
collects/images/scribblings/flomap.scrbl Normal file
View File

@ -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]

9
collects/images/scribblings/images.scrbl
View File

@ -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. 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}. 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[] @table-of-contents[]
@include-section["icons.scrbl"] @include-section["icons.scrbl"]
@include-section["logos.scrbl"] @include-section["logos.scrbl"]
@include-section["compile-time.scrbl"] @include-section["compile-time.scrbl"]
@include-section["flomap.scrbl"]

6
collects/images/tests/effects-tests.rkt
View File

@ -17,15 +17,15 @@
(define end-frame-quality 90) (define end-frame-quality 90)
(define mid-frame-quality 35) (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 (define plt-fm
(flomap-shadowed (flomap-inset (plt-flomap (- size (* 4 blur))) (* 2 blur)) (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 (define racket-fm
(flomap-shadowed (flomap-inset (racket-flomap (- size (* 4 blur))) (* 2 blur)) (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)) (define logo-flomap* (flomap-whirl-morph plt-fm racket-fm))