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

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

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

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
+            ;; Shadow intersection point
-            (define sx (max 0.0 (min sx-max (+ x (* dist tx)))))
+            (define sx (+ x (* dist tx)))
-            (define sy (max 0.0 (min sy-max (+ y (* dist ty)))))
+            (define sy (+ y (* dist ty)))
-            (define floor-sx (floor sx))
+            ;; Shadow intersection color
-            (define floor-sy (floor sy))
+            (define sr (flomap-bilinear-ref shadow-fm 0 sx sy))
-            (define bx (fl->fx floor-sx))
+            (define sg (flomap-bilinear-ref shadow-fm 1 sx sy))
-            (define by (fl->fx floor-sy))
+            (define sb (flomap-bilinear-ref shadow-fm 2 sx 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))
             ;; 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 transmitted-fm))
-  (values reflected-fm
-          (flomap-blur transmitted-fm ideal-transmission-blur)))
 
 ;; ===================================================================================================
 ;; Full rendering

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 ...)))]))
 

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
+                     (pict->bitmap (inset (cc-superimpose brush-pict pen-pict) 1))
-                      (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}