From 695583e90bfb3bb096653d9769d8bb60ae6d3f3f Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Mon, 16 Jan 2012 22:30:52 -0700 Subject: [PATCH] Added clock icon Fixed faulty bilinear interpolation in shadow intersection, removed blurring hack Fixed caching bug (for some reason, generate-temporaries didn't create a unique symbol - note, not *identifier*; used gensym instead) Please merge into release --- collects/images/icons/misc.rkt | 82 ++++++++++++++++++- collects/images/icons/style.rkt | 4 +- .../images/private/deep-flomap-render.rkt | 56 ++----------- collects/images/private/utils.rkt | 3 +- collects/images/scribblings/icons.scrbl | 9 +- 5 files changed, 100 insertions(+), 54 deletions(-) diff --git a/collects/images/icons/misc.rkt b/collects/images/icons/misc.rkt index 39dbed334b..84345699b1 100644 --- a/collects/images/icons/misc.rkt +++ b/collects/images/icons/misc.rkt @@ -17,7 +17,8 @@ magnifying-glass-icon magnifying-glass-flomap left-magnifying-glass-icon left-magnifying-glass-flomap bomb-icon bomb-flomap - left-bomb-icon left-bomb-flomap) + left-bomb-icon left-bomb-flomap + clock-icon clock-flomap) (only-doc-out (all-defined-out))) (define (flat-regular-polygon-flomap sides start color size) @@ -251,6 +252,78 @@ ) flomap? (flomap-flip-horizontal (left-bomb-flomap cap-color bomb-color height material))) +;; =================================================================================================== +;; Clock + +(define clock-shell-material + (deep-flomap-material-value + 'glass 3.0 0.75 0.0 + 0.5 0.15 1.0 + 0.1 0.1 0.6 + 0.0)) + +(defproc (clock-flomap [height (and/c rational? (>=/c 0)) (default-icon-height)] + [face-color (or/c string? (is-a?/c color%)) light-metal-icon-color] + [hand-color (or/c string? (is-a?/c color%)) "firebrick"] + [hours (integer-in 0 11) 1] + [minutes (real-in 0 60) 33]) flomap? + (make-cached-flomap + [height face-color hand-color hours minutes] + (define R 12) + (define hour-θ (* (+ (- hours 3) (/ minutes 60)) (/ (* 2 pi) 12))) + (define minute-θ (* (- minutes 15) (/ (* 2 pi) 60))) + (define 60-degrees (* 60 (/ (* 2 pi) 180))) + (define scale (/ height 32)) + + (define face-fm + (draw-icon-flomap + 32 32 (λ (dc) + ;; face + (set-icon-pen dc (icon-color->outline-color face-color) 1 'solid) + (send dc set-brush face-color 'solid) + (draw-ellipse/smoothed dc 0 0 32 32) + ;; ticks + (set-icon-pen dc "black" 1 'solid) + (for ([θ (in-range 0 (* 2 pi) (* 1/6 pi))] + [i (in-cycle (in-range 0 3))]) + (define r (if (= i 0) 2 1)) + (send dc draw-line + (+ 15.5 (* (- R r) (cos θ))) + (+ 15.5 (* (- R r) (sin θ))) + (+ 15.5 (* R (cos θ))) + (+ 15.5 (* R (sin θ))))) + (set-icon-pen dc (icon-color->outline-color hand-color) 1/2 'solid) + (send dc set-brush hand-color 'solid) + ;; minute hand + (send dc draw-polygon + (list (cons (+ 15.5 (* R (cos minute-θ))) + (+ 15.5 (* R (sin minute-θ)))) + (cons (+ 15.5 (* 1.5 (cos (+ minute-θ 60-degrees)))) + (+ 15.5 (* 1.5 (sin (+ minute-θ 60-degrees))))) + (cons (+ 15.5 (* 1.5 (cos (- minute-θ 60-degrees)))) + (+ 15.5 (* 1.5 (sin (- minute-θ 60-degrees))))))) + ;; hour hand + (send dc draw-polygon + (list (cons (+ 15.5 (* (- R 4) (cos hour-θ))) + (+ 15.5 (* (- R 4) (sin hour-θ)))) + (cons (+ 15.5 (* 1.5 (cos (+ hour-θ 60-degrees)))) + (+ 15.5 (* 1.5 (sin (+ hour-θ 60-degrees))))) + (cons (+ 15.5 (* 1.5 (cos (- hour-θ 60-degrees)))) + (+ 15.5 (* 1.5 (sin (- hour-θ 60-degrees)))))))) + scale)) + + (define shell-fm + (draw-icon-flomap + 32 32 (λ (dc) + (set-icon-pen dc (icon-color->outline-color "white") 1 'solid) + (send dc set-brush "white" 'solid) + (draw-ellipse/smoothed dc 0 0 32 32)) + scale)) + + (let* ([dfm (flomap->deep-flomap shell-fm)] + [dfm (deep-flomap-bulge-spheroid dfm (* 8 scale))]) + (deep-flomap-render-icon dfm clock-shell-material face-fm)))) + ;; =================================================================================================== ;; Bitmaps (icons) @@ -262,6 +335,13 @@ ) (is-a?/c bitmap%) (flomap->bitmap (regular-polygon-flomap sides start color height material))) +(defproc (clock-icon [height (and/c rational? (>=/c 0)) (default-icon-height)] + [face-color (or/c string? (is-a?/c color%)) light-metal-icon-color] + [hand-color (or/c string? (is-a?/c color%)) "firebrick"] + [hours (integer-in 0 11) 1] + [minutes (real-in 0 60) 33]) (is-a?/c bitmap%) + (flomap->bitmap (clock-flomap height face-color hand-color hours minutes))) + (define-icon-wrappers ([color (or/c string? (is-a?/c color%))] [height (and/c rational? (>=/c 0)) (default-icon-height)] diff --git a/collects/images/icons/style.rkt b/collects/images/icons/style.rkt index b1f5da12a7..cbacf5bb6b 100644 --- a/collects/images/icons/style.rkt +++ b/collects/images/icons/style.rkt @@ -110,11 +110,11 @@ '(1.0 1.0 1.0) '(1.0 1.0 1.0))) -(define (deep-flomap-render-icon dfm material) +(define (deep-flomap-render-icon dfm material [background-fm #f]) ;(printf "rendering~n") (parameterize/group ([deep-flomap-material material] [deep-flomap-lighting icon-lighting]) - (deep-flomap-render dfm))) + (deep-flomap-render dfm background-fm))) (define (deep-flomap-icon-style dfm [height 20]) (define s (/ (deep-flomap-height dfm) 32)) diff --git a/collects/images/private/deep-flomap-render.rkt b/collects/images/private/deep-flomap-render.rkt index bc88565271..6d6dd3ce15 100644 --- a/collects/images/private/deep-flomap-render.rkt +++ b/collects/images/private/deep-flomap-render.rkt @@ -13,7 +13,6 @@ ;; Hacks (define specular-blur 1/2) (define diffuse-blur 1/2) -(define ideal-transmission-blur 1) (define ambient-transmission-blur-fraction 1/32) ;; =================================================================================================== @@ -353,10 +352,6 @@ (define sin-wall-tilt-θ (sin wall-tilt-θ)) (match-define (list Irr Irg Irb) (reflected-intensity)) - ;; max coords of the shadow image - ;; subtract epsilon to ensure that sx < (w - 1) so that (flfloor sx) < (w - 1) (similarly for sy) - (define sx-max (- w 1.00001)) - (define sy-max (- h 1.00001)) ;; material properties (define η2 (refractive-index)) (define η1/η2 (/ 1.0 η2)) @@ -416,46 +411,13 @@ ;; sz = z + dist * tz, so dist = (sz - z) / tz (define dist (/ (- 0.0 z) tz)) (when (and (dist . >= . 0.0) (dist . < . +inf.0)) - ;; Find the color of the point on the shadow that the ray struck - (define sx (max 0.0 (min sx-max (+ x (* dist tx))))) - (define sy (max 0.0 (min sy-max (+ y (* dist ty))))) - (define floor-sx (floor sx)) - (define floor-sy (floor sy)) - (define bx (fl->fx floor-sx)) - (define by (fl->fx floor-sy)) - ;; Bilinearly interpolate the four colors nearest the point on the shadow - (define 1-αx (- sx floor-sx)) - (define 1-αy (- sy floor-sy)) - (define αx (- 1.0 1-αx)) - (define αy (- 1.0 1-αy)) - ;; upper-left weighted values - (define j1 (fx* 3 (fx+ bx (fx* by w)))) - (define r1 (unsafe-flvector-ref shadow-vs j1)) - (define g1 (unsafe-flvector-ref shadow-vs (fx+ j1 1))) - (define b1 (unsafe-flvector-ref shadow-vs (fx+ j1 2))) - (define-values (sr1 sg1 sb1) (fl3* r1 g1 b1 (* αx αy))) - ;; upper-right weighted values - (define j2 (fx+ j1 3)) - (define r2 (unsafe-flvector-ref shadow-vs j2)) - (define g2 (unsafe-flvector-ref shadow-vs (fx+ j2 1))) - (define b2 (unsafe-flvector-ref shadow-vs (fx+ j2 2))) - (define-values (sr2 sg2 sb2) (fl3* r2 g2 b2 (* 1-αx αy))) - ;; lower-left weighted values - (define j3 (fx+ j1 (fx* 3 w))) - (define r3 (unsafe-flvector-ref shadow-vs j3)) - (define g3 (unsafe-flvector-ref shadow-vs (fx+ j3 1))) - (define b3 (unsafe-flvector-ref shadow-vs (fx+ j3 2))) - (define-values (sr3 sg3 sb3) (fl3* r3 g3 b3 (* αx 1-αy))) - ;; lower-right weighted values - (define j4 (fx+ j3 3)) - (define r4 (unsafe-flvector-ref shadow-vs j4)) - (define g4 (unsafe-flvector-ref shadow-vs (fx+ j4 1))) - (define b4 (unsafe-flvector-ref shadow-vs (fx+ j4 2))) - (define-values (sr4 sg4 sb4) (fl3* r4 g4 b4 (* 1-αx 1-αy))) - ;; final interpolated shadow color - (define sr (+ sr1 sr2 sr3 sr4)) - (define sg (+ sg1 sg2 sg3 sg4)) - (define sb (+ sb1 sb2 sb3 sb4)) + ;; Shadow intersection point + (define sx (+ x (* dist tx))) + (define sy (+ y (* dist ty))) + ;; Shadow intersection color + (define sr (flomap-bilinear-ref shadow-fm 0 sx sy)) + (define sg (flomap-bilinear-ref shadow-fm 1 sx sy)) + (define sb (flomap-bilinear-ref shadow-fm 2 sx sy)) ;; normalized distance to the surface (define norm-dist (/ dist opacity-z)) ;; intensities of each r g b by the time the light emerges from the surface @@ -471,9 +433,7 @@ (unsafe-flvector-set! transmitted-vs (fx+ j 1) g) (unsafe-flvector-set! transmitted-vs (fx+ j 2) b)))))) - ;; blur to cut down on sparklies (poor man's supersampling) - (values reflected-fm - (flomap-blur transmitted-fm ideal-transmission-blur))) + (values reflected-fm transmitted-fm)) ;; =================================================================================================== ;; Full rendering diff --git a/collects/images/private/utils.rkt b/collects/images/private/utils.rkt index be90de5744..70b5f650f4 100644 --- a/collects/images/private/utils.rkt +++ b/collects/images/private/utils.rkt @@ -72,7 +72,8 @@ (define-syntax (make-cached-flomap stx) (syntax-case stx () [(_ (size args ...) expr0 expr ...) - (with-syntax ([(name) (generate-temporaries #'(make-cached-flomap))]) + ;; for some reason, generate-temporaries doesn't work here + (with-syntax ([name (gensym)]) (syntax/loc stx (make-cached-flomap* 'name (λ (size args ...) expr0 expr ...) size args ...)))])) diff --git a/collects/images/scribblings/icons.scrbl b/collects/images/scribblings/icons.scrbl index ee9c776dc7..811fce839b 100644 --- a/collects/images/scribblings/icons.scrbl +++ b/collects/images/scribblings/icons.scrbl @@ -193,8 +193,7 @@ As an example, here is how to duplicate the @racket[record-icon] using @racketmo (define brush-pict (colorize (filled-ellipse 62 62) "forestgreen")) (define pen-pict (linewidth 2 (colorize (ellipse 62 62) outline-color))) (bitmap-render-icon - (pict->bitmap - (inset (cc-superimpose brush-pict pen-pict) 1)) + (pict->bitmap (inset (cc-superimpose brush-pict pen-pict) 1)) 5/8 glass-icon-material) (record-icon "forestgreen" 64 glass-icon-material)] @@ -387,6 +386,12 @@ Equivalent to @racket[(regular-polygon-icon 8 (/ (* 2 pi) 16) color height mater (left-bomb-icon metal-icon-color dark-metal-icon-color 32)] } +@doc-apply[clock-icon]{ +@examples[#:eval icons-eval + (clock-icon 48) + (clock-icon 48 "lightblue" "darkblue" 3 21)] +} + @;==================================================================================================== @section[#:tag "stickman"]{Stickman Icons}