diff --git a/collects/plot/common/draw.rkt b/collects/plot/common/draw.rkt index d528225543..8f9d0421f1 100644 --- a/collects/plot/common/draw.rkt +++ b/collects/plot/common/draw.rkt @@ -63,8 +63,10 @@ (min (max i 1) 255)) (define (real->color-byte f) - (define i (inexact->exact (floor f))) - (min (max i 0) 255)) + (cond [(rational? f) (define i (inexact->exact (floor f))) + (min (max i 0) 255)] + [(eqv? f +inf.0) 255] + [else 0])) ;; Returns an immutable instance of color%. Immutable colors are faster because they don't have to ;; have immutable copies made when they're used in a dc. diff --git a/collects/plot/plot3d/plot-area.rkt b/collects/plot/plot3d/plot-area.rkt index f03b61716b..3660b1d395 100644 --- a/collects/plot/plot3d/plot-area.rkt +++ b/collects/plot/plot3d/plot-area.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/class racket/match racket/list racket/math racket/contract racket/vector racket/flonum + unstable/flonum "../common/math.rkt" "../common/plot-device.rkt" "../common/ticks.rkt" @@ -683,8 +684,16 @@ (define light (m3-apply rotate-rho-matrix (vector (- -0.5 2.0) (- -0.5 2.0) (+ 0.5 5.0)))) - ;; View direction, in normalized view coordinates: many graph widths backward - (define view-dir (vector 0.0 -50.0 0.0)) + + ;; Do lighting only by direction so we can precalculate light-dir and half-dir + ;; Conceptually, the viewer and light are at infinity + + ;; Light direction + (define light-dir (vnormalize light)) + ;; View direction, in normalized view coordinates + (define view-dir (vector 0.0 -1.0 0.0)) + ;; Blinn-Phong "half angle" direction + (define half-dir (vnormalize (v* (v+ light-dir view-dir) 0.5))) (define diffuse-light? (plot3d-diffuse-light?)) (define specular-light? (plot3d-specular-light?)) @@ -695,18 +704,18 @@ [(not (or diffuse-light? specular-light?)) (λ (v normal) (values 1.0 0.0))] [else (λ (v normal) - ; common lighting values - (define light-dir (vnormalize (v- light v))) - ; diffuse lighting: typical Lambertian surface model - (define diff (if diffuse-light? (abs (vdot normal light-dir)) 1.0)) - ; specular highlighting: Blinn-Phong model - (define spec (cond [specular-light? - (define lv (v* (v+ light-dir view-dir) 0.5)) - (define cos-angle (/ (abs (vdot normal lv)) (vmag lv))) - (* 32.0 (expt cos-angle 10.0))] - [else 0.0])) - ; put it all together - (values (+ ambient-light (* (- 1.0 ambient-light) diff)) spec))])) + ;; Diffuse lighting: typical Lambertian surface model (using absolute value because we + ;; can't expect surface normals to point the right direction) + (define diff + (cond [diffuse-light? (flabs (vdot normal light-dir))] + [else 1.0])) + ;; Specular highlighting: Blinn-Phong model + (define spec + (cond [specular-light? (fl* 32.0 (flexpt (flabs (vdot normal half-dir)) 20.0))] + [else 0.0])) + ;; Blend ambient light with diffuse light, return specular as it is + ;; As ambient-light -> 1.0, contribution of diffuse -> 0.0 + (values (fl+ ambient-light (fl* (fl- 1.0 ambient-light) diff)) spec))])) ;; =============================================================================================== ;; Public drawing control (used by plot3d/dc) diff --git a/collects/unstable/flonum.rkt b/collects/unstable/flonum.rkt index 0b325c7644..2359dbfdd9 100644 --- a/collects/unstable/flonum.rkt +++ b/collects/unstable/flonum.rkt @@ -2,7 +2,7 @@ (require racket/unsafe/ops) -(provide flatan2 flmodulo +(provide flatan2 flmodulo flexpt flonum->bit-field bit-field->flonum flonum->ordinal ordinal->flonum flstep flnext flprev @@ -18,6 +18,11 @@ [(not (flonum? y)) (raise-type-error 'flmodulo "flonum" 1 x y)] [else (unsafe-fl- x (unsafe-fl* y (unsafe-flfloor (unsafe-fl/ x y))))])) +(define (flexpt b x) + (cond [(not (flonum? b)) (raise-type-error 'flexpt "flonum" 0 b x)] + [(not (flonum? x)) (raise-type-error 'flexpt "flonum" 1 b x)] + [else (unsafe-flexp (unsafe-fl* x (unsafe-fllog b)))])) + (define (flonum->bit-field x) (cond [(flonum? x) (integer-bytes->integer (real->floating-point-bytes x 8) #f)] [else (raise-type-error 'flonum->bit-field "flonum" x)])) @@ -62,13 +67,3 @@ (define -min.0 (flprev 0.0)) (define +min.0 (flnext 0.0)) (define +max.0 (flprev +inf.0)) - -#| -(require plot) - -(parameterize ([plot-x-ticks (log-ticks #:base 2 #:number 5)] - [y-axis-ticks? #f]) - (plot (list (function (λ (x) (flonum->ordinal (exact->inexact x))) - 1/4 4) - (map y-axis '(1/2 1 2))))) -|#