From 2313b528c4c0e8b7940e746481f58b1d6722cdf9 Mon Sep 17 00:00:00 2001
From: Neil Toronto <ntoronto@racket-lang.org>
Date: Wed, 11 Jan 2012 16:45:23 -0700
Subject: [PATCH] Added standing and running stickman icons

Optimize rendering by looping only over the smallest rectangle with nonzero alpha

Please merge into release
---
 collects/images/icons/stickman.rkt            | 332 ++++++++++++++++++
 .../images/private/deep-flomap-render.rkt     |  27 +-
 2 files changed, 349 insertions(+), 10 deletions(-)
 create mode 100644 collects/images/icons/stickman.rkt

diff --git a/collects/images/icons/stickman.rkt b/collects/images/icons/stickman.rkt
new file mode 100644
index 0000000000..574825a91d
--- /dev/null
+++ b/collects/images/icons/stickman.rkt
@@ -0,0 +1,332 @@
+#lang racket/gui
+
+(require racket/class racket/snip racket/vector
+         "../private/flomap.rkt"
+         "../private/deep-flomap.rkt"
+         "../private/utils.rkt"
+         "style.rkt")
+
+(provide standing-stickman-flomap standing-stickman-icon
+         running-stickman-flomap running-stickman-icon)
+
+(define (cons+ p1 p2)
+  (match-define (cons x1 y1) p1)
+  (match-define (cons x2 y2) p2)
+  (cons (+ x1 x2) (+ y1 y2)))
+
+(define (polar->cartesian angle mag)
+  (cons (* mag (cos (* (/ pi 180) angle)))
+        (* mag (sin (* (/ pi 180) angle)))))
+
+(define line-width 1)
+(define body-width 4.5)
+(define leg-width 4)
+(define arm-width 3.5)
+
+(define neck-length 6)
+(define torso-length 6)
+(define upper-arm-length 5)
+(define lower-arm-length 5.5)
+(define thigh-length 6.5)
+(define shin-length 6.5)
+(define shoulder-breadth 7)
+
+(define standing-torso-angle -90)
+(define standing-neck-angle 5)
+(define standing-left-knee-angle 200)
+(define standing-left-foot-angle 0)
+(define standing-right-knee-angle 150)
+(define standing-right-foot-angle 20)
+(define standing-left-elbow-angle 230)
+(define standing-left-hand-angle -90)
+(define standing-right-elbow-angle 140)
+(define standing-right-hand-angle 90)
+
+(define standing-hip-point (cons 14 (- 29 (+ thigh-length shin-length))))
+
+(define standing-neck-point
+  (cons+ standing-hip-point
+         (polar->cartesian standing-torso-angle torso-length)))
+
+(define standing-head-point
+  (cons+ standing-neck-point
+         (polar->cartesian (+ standing-neck-angle standing-torso-angle)
+                           neck-length)))
+
+(define standing-left-knee-point
+  (cons+ standing-hip-point
+         (polar->cartesian (+ standing-left-knee-angle standing-torso-angle)
+                           thigh-length)))
+
+(define standing-left-foot-point
+  (cons+ standing-left-knee-point
+         (polar->cartesian (+ standing-left-knee-angle standing-torso-angle standing-left-foot-angle)
+                           shin-length)))
+
+(define standing-left-shoulder-point
+  (cons+ standing-neck-point (cons (* -1/2 shoulder-breadth) 0)))
+
+(define standing-left-elbow-point
+  (cons+ standing-left-shoulder-point
+         (polar->cartesian (+ standing-left-elbow-angle standing-torso-angle)
+                           upper-arm-length)))
+
+(define standing-left-hand-point
+  (cons+ standing-left-elbow-point
+         (polar->cartesian (+ standing-left-elbow-angle standing-torso-angle standing-left-hand-angle)
+                           lower-arm-length)))
+
+(define standing-right-knee-point
+  (cons+ standing-hip-point
+         (polar->cartesian (+ standing-right-knee-angle standing-torso-angle)
+                           thigh-length)))
+
+(define standing-right-foot-point
+  (cons+ standing-right-knee-point
+         (polar->cartesian (+ standing-right-knee-angle standing-torso-angle standing-right-foot-angle)
+                           shin-length)))
+
+(define standing-right-shoulder-point
+  (cons+ standing-neck-point (cons (* 1/2 shoulder-breadth) 0)))
+  
+
+(define standing-right-elbow-point
+  (cons+ standing-right-shoulder-point
+         (polar->cartesian (+ standing-right-elbow-angle standing-torso-angle)
+                           upper-arm-length)))
+
+(define standing-right-hand-point
+  (cons+ standing-right-elbow-point
+         (polar->cartesian (+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle)
+                           lower-arm-length)))
+
+(define (draw-short-rendered-icon-flomap w h proc scale material)
+  (let* ([fm  (draw-icon-flomap w h proc scale)]
+         [dfm  (flomap->deep-flomap fm)]
+         [dfm  (deep-flomap-icon-style dfm)]
+         [dfm  (deep-flomap-raise dfm (* -18 (/ (flomap-height fm) 32)))])
+    (deep-flomap-render-icon dfm material)))
+
+(define (standing-stickman-flomap color arm-color head-color
+                                  [height (default-icon-height)]
+                                  [material (default-icon-material)])
+  (make-cached-flomap
+   [height color arm-color head-color material]
+   (flomap-lt-superimpose
+    (draw-short-rendered-icon-flomap 
+     26 32 (λ (dc)
+             (send dc set-pen "black" (+ arm-width (* 2 line-width)) 'solid)
+             (send dc draw-lines (list standing-right-shoulder-point
+                                       standing-right-elbow-point
+                                       standing-right-hand-point))
+             (send dc set-pen arm-color arm-width 'solid)
+             (send dc draw-lines (list standing-right-shoulder-point
+                                       standing-right-elbow-point
+                                       standing-right-hand-point)))
+     (/ height 32)
+     material)
+    (draw-short-rendered-icon-flomap 
+     26 32 (λ (dc)
+             (send dc set-pen "black" (+ body-width (* 2 line-width)) 'solid)
+             (send dc draw-lines (list standing-neck-point standing-hip-point))
+             (send dc set-pen "black" (+ leg-width (* 2 line-width)) 'solid)
+             (send dc draw-lines (list standing-hip-point
+                                       standing-left-knee-point
+                                       standing-left-foot-point))
+             (send dc draw-lines (list standing-hip-point
+                                       standing-right-knee-point
+                                       standing-right-foot-point))
+             (send dc set-pen color body-width 'solid)
+             (send dc draw-lines (list standing-neck-point standing-hip-point))
+             (send dc set-pen color leg-width 'solid)
+             (send dc draw-lines (list standing-hip-point
+                                       standing-left-knee-point
+                                       standing-left-foot-point))
+             (send dc draw-lines (list standing-hip-point
+                                       standing-right-knee-point
+                                       standing-right-foot-point)))
+     (/ height 32)
+     material)
+    (draw-short-rendered-icon-flomap 
+     26 32 (λ (dc)
+             (send dc set-pen "black" (+ arm-width (* 2 line-width)) 'solid)
+             (send dc draw-lines (list standing-left-shoulder-point
+                                       standing-left-elbow-point
+                                       standing-left-hand-point))
+             (send dc set-pen arm-color arm-width 'solid)
+             (send dc draw-lines (list standing-left-shoulder-point
+                                       standing-left-elbow-point
+                                       standing-left-hand-point)))
+     (/ height 32)
+     material)
+    (draw-short-rendered-icon-flomap 
+     26 32 (λ (dc)
+             (send dc set-pen "black" line-width 'solid)
+             (send dc set-brush head-color 'solid)
+             (match-define (cons x y) standing-head-point)
+             (draw-ellipse/smoothed dc (- x 3.5) (- y 3.5) 8 8))
+     (/ height 32)
+     material))))
+
+(define running-neck-angle 20)
+(define running-torso-angle -70)
+
+(define (squash* x scale)
+  (/ 1 (+ 1 (exp (- (* scale (- x 1/2)))))))
+
+(define (squash x scale)
+  (define y-min (squash* 0 scale))
+  (define y-max (squash* 1 scale))
+  (let* ([x  (max 0.0 (min 1.0 x))]
+         [y  (squash* x scale)]
+         [y  (/ (- y y-min) (- y-max y-min))])
+    (max 0.0 (min 1.0 y))))
+
+(define (cycle t)
+  (* 0.5 (+ 1.0 (cos (* 2.0 pi (+ 0.5 t))))))
+
+(define (scale-angle θ θ-min θ-max)
+  (+ θ-min (* θ (- θ-max θ-min))))
+
+(define (running-foot-angle t)
+  (scale-angle (squash (cycle (+ -0.3333 t)) 3) 0 125))
+
+(define (running-knee-angle t)
+  (scale-angle (squash (cycle t) 2) 90 210))
+
+(define (running-hip-height t)
+  (+ (- 27 (+ thigh-length shin-length))
+     (* 2 (squash (cycle (+ 0.125 (* 2 t))) 5))))
+
+(define (running-elbow-angle t)
+  (scale-angle (squash (cycle (+ 0.5 t)) 4) 150 240))
+
+(define (running-hand-angle t)
+  (scale-angle (squash (cycle (+ 0.6666 t)) 6) -115 -30))
+
+(define (running-hip-point t) (cons 14 (running-hip-height t)))
+
+(define (running-shoulder-point t)
+  (cons+ (running-hip-point t)
+         (polar->cartesian running-torso-angle torso-length)))
+
+(define (running-head-point t)
+  (cons+ (running-shoulder-point t)
+         (polar->cartesian (+ running-neck-angle running-torso-angle)
+                           neck-length)))
+
+(define (running-knee-point t)
+  (cons+ (running-hip-point t)
+         (polar->cartesian (+ (running-knee-angle t) running-torso-angle)
+                           thigh-length)))
+
+(define (running-foot-point t)
+  (cons+ (running-knee-point t)
+         (polar->cartesian (+ (running-knee-angle t) running-torso-angle (running-foot-angle t))
+                           shin-length)))
+
+(define (running-elbow-point t)
+  (cons+ (running-shoulder-point t)
+         (polar->cartesian (+ (running-elbow-angle t) running-torso-angle)
+                           upper-arm-length)))
+
+(define (running-hand-point t)
+  (cons+ (running-elbow-point t)
+         (polar->cartesian (+ (running-elbow-angle t) running-torso-angle (running-hand-angle t))
+                           lower-arm-length)))
+
+(define (draw-running-body dc t color width)
+  (send dc set-pen color width 'solid)
+  (send dc draw-lines (list (running-hip-point t) (running-shoulder-point t))))
+
+(define (draw-running-leg dc t color width)
+  (send dc set-pen color width 'solid)
+  (send dc draw-lines
+        (list (running-hip-point t) (running-knee-point t) (running-foot-point t))))
+
+(define (draw-running-arm dc t color width)
+  (send dc set-pen color width 'solid)
+  (send dc draw-lines
+        (list (running-shoulder-point t) (running-elbow-point t) (running-hand-point t))))
+
+(define (running-head-flomap t color height material)
+  (make-cached-flomap
+   [height t color material]
+   (draw-short-rendered-icon-flomap 
+    26 32 (λ (dc)
+            (send dc set-pen "black" line-width 'solid)
+            (send dc set-brush color 'solid)
+            (match-define (cons x y) (running-head-point t))
+            (draw-ellipse/smoothed dc (- x 3.5) (- y 3.5) 8 8))
+    (/ height 32)
+    material)))
+
+(define (running-leg-flomap t body? color height material)
+  (make-cached-flomap
+   [height t body? color material]
+   (draw-short-rendered-icon-flomap 
+    26 32 (λ (dc)
+            (draw-running-leg dc t "black" (+ leg-width (* 2 line-width)))
+            (when body?
+              (draw-running-body dc t "black" (+ body-width (* 2 line-width)))
+              (draw-running-body dc t color body-width))
+            (draw-running-leg dc t color leg-width))
+    (/ height 32)
+    material)))
+
+(define (running-arm-flomap t color height material)
+  (make-cached-flomap
+   [height t color material]
+   (draw-short-rendered-icon-flomap 
+    26 32 (λ (dc)
+            (draw-running-arm dc t "black" (+ arm-width (* 2 line-width)))
+            (draw-running-arm dc t color arm-width))
+    (/ height 32)
+    material)))
+
+(define (running-stickman-flomap t color arm-color head-color
+                                 [height (default-icon-height)]
+                                 [material (default-icon-material)])
+  (make-cached-flomap
+   [height t color arm-color head-color material]
+   (flomap-lt-superimpose (running-arm-flomap (+ t 0.5) arm-color height material)
+                          (running-leg-flomap (+ t 0.5) #f color height material)
+                          (running-leg-flomap t #t color height material)
+                          (running-head-flomap t head-color height material)
+                          (running-arm-flomap t arm-color height material))))
+
+(define standing-stickman-icon (compose flomap->bitmap standing-stickman-flomap))
+(define running-stickman-icon (compose flomap->bitmap running-stickman-flomap))
+
+#;
+(begin
+  (require (planet "animated-canvas.rkt" ("williams" "animated-canvas.plt" 2 4)))
+  
+  (define size 20)
+  
+  (standing-stickman-icon halt-icon-color "white" halt-icon-color size)
+  
+  (define framerate 12)
+ 
+  (default-icon-material glass-icon-material)
+  (define frame-bitmaps
+    (for/vector ([t  (in-range 0 1 (/ 1 framerate))])
+      (time (running-stickman-icon t run-icon-color "white" run-icon-color size))))
+  (printf "~v~n" frame-bitmaps)
+  
+  (define frame (make-object frame% "Canvas"))
+  (define canvas (new animated-canvas%
+                      [parent frame] [style '(border)]
+                      [min-width (+ size 4)] [min-height (+ size 4)]))
+  (send frame show #t)
+  
+  (define i 0)
+  (define timer (make-object timer% (λ ()
+                                      (define bm (vector-ref frame-bitmaps i))
+                                      (set! i (modulo (+ i 1) framerate))
+                                      (define dc (send canvas get-dc))
+                                      (send dc draw-bitmap bm 0 0)
+                                      (send canvas swap-bitmaps)
+                                      (yield))
+                  (round (* 1000 (/ 1 framerate)))))
+  )
diff --git a/collects/images/private/deep-flomap-render.rkt b/collects/images/private/deep-flomap-render.rkt
index 219740d138..bc88565271 100644
--- a/collects/images/private/deep-flomap-render.rkt
+++ b/collects/images/private/deep-flomap-render.rkt
@@ -70,8 +70,9 @@
 ;; ===================================================================================================
 ;; Pass 1: tracing from a directional light source
 
-(: trace-directional-light (flomap flomap flomap flomap -> (values flomap flomap)))
-(define (trace-directional-light alpha-fm rgb-fm z-fm normal-fm)
+(: trace-directional-light (flomap flomap flomap flomap Integer Integer Integer Integer
+                                   -> (values flomap flomap)))
+(define (trace-directional-light alpha-fm rgb-fm z-fm normal-fm x-min x-max y-min y-max)
   (match-define (flomap alpha-vs 1 w h) alpha-fm)
   (match-define (list rgb-vs z-vs normal-vs) (map flomap-values (list rgb-fm z-fm normal-fm)))
   
@@ -115,7 +116,8 @@
   (define sy-vs (make-flvector (* w h) +nan.0))
   (define Irgb-vs (make-flvector (* 3 w h)))
   
-  (for*: ([int-y : Integer  (in-range h)] [int-x : Integer  (in-range w)])
+  (for*: ([int-y : Integer  (in-range y-min y-max)]
+          [int-x : Integer  (in-range x-min x-max)])
     (define i (fx+ int-x (fx* int-y w)))
     (define a (unsafe-flvector-ref alpha-vs i))
     (when (a . > . 0.0)
@@ -202,7 +204,8 @@
   (define ambient-shadow-fm (make-flomap 3 w h))
   (define ambient-shadow-vs (flomap-values ambient-shadow-fm))
   (when (Ta . > . 0.0)
-    (for*: ([int-y : Integer  (in-range h)] [int-x : Integer  (in-range w)])
+    (for*: ([int-y : Integer  (in-range y-min y-max)]
+            [int-x : Integer  (in-range x-min x-max)])
       (define i (fx+ int-x (fx* int-y w)))
       (define a (unsafe-flvector-ref alpha-vs i))
       (when (a . > . 0.0)
@@ -227,7 +230,8 @@
     ;; Gaussian kernels - make as wide as possible to keep from having to reallocate
     (define kxs (make-flvector w))
     (define kys (make-flvector h))
-    (for*: ([int-y : Integer  (in-range (- h 1))] [int-x : Integer  (in-range (- w 1))])
+    (for*: ([int-y : Integer  (in-range y-min (- y-max 1))]
+            [int-x : Integer  (in-range x-min (- x-max 1))])
       (define i00 (fx+ int-x (fx* int-y w)))
       (define i01 (fx+ i00 1))
       (define i10 (fx+ i00 w))
@@ -327,8 +331,9 @@
 ;; ===================================================================================================
 ;; Pass 2: tracing from a directional viewer
 
-(: trace-directional-view (flomap flomap flomap flomap flomap -> (values flomap flomap)))
-(define (trace-directional-view alpha-fm rgb-fm z-fm normal-fm shadow-fm)
+(: trace-directional-view (flomap flomap flomap flomap flomap Integer Integer Integer Integer
+                                  -> (values flomap flomap)))
+(define (trace-directional-view alpha-fm rgb-fm z-fm normal-fm shadow-fm x-min x-max y-min y-max)
   (define-values (w h) (flomap-size alpha-fm))
   (match-define (list alpha-vs rgb-vs z-vs normal-vs shadow-vs)
     (map flomap-values (list alpha-fm rgb-fm z-fm normal-fm shadow-fm)))
@@ -364,7 +369,8 @@
   (define transmitted-vs (flomap-values transmitted-fm))
   
   (when (or (Ri . > . 0.0) (Ti . > . 0.0))
-    (for*: ([int-y : Integer  (in-range h)] [int-x : Integer  (in-range w)])
+    (for*: ([int-y : Integer  (in-range y-min y-max)]
+            [int-x : Integer  (in-range x-min x-max)])
       (define i (fx+ int-x (fx* int-y w)))
       (define a (unsafe-flvector-ref alpha-vs i))
       (when (a . > . 0.0)
@@ -497,10 +503,11 @@
      (define z-fm (fmmax 0.0 (deep-flomap-z dfm)))
      (define normal-fm (flomap-gradient-normal z-fm))
      (define bg-fm (if background-fm (prep-background background-fm w h) #f))
+     (define-values (_1 x-min y-min _2 x-max y-max) (flomap-nonzero-rect alpha-fm))
      
      ;; pass 1: trace from the light source
      (define-values (diffracted-fm raw-shadow-fm)
-       (trace-directional-light alpha-fm rgb-fm z-fm normal-fm))
+       (trace-directional-light alpha-fm rgb-fm z-fm normal-fm x-min x-max y-min y-max))
      
      ;; blur the shadow to simulate internal scatter
      (define σ (* (min w h) (shadow-blur)))
@@ -517,7 +524,7 @@
      
      ;; pass 2: trace from the viewer
      (define-values (reflected-fm transmitted-fm)
-       (trace-directional-view alpha-fm rgb-fm z-fm normal-fm shadow-fm))
+       (trace-directional-view alpha-fm rgb-fm z-fm normal-fm shadow-fm x-min x-max y-min y-max))
      
      ;; add all the light together, convert to premultiplied-alpha flomap
      (let* ([fm  (fm+ (fm+ diffracted-fm transmitted-fm) reflected-fm)]