Speed/readability improvements in contour, surface and isosurface renderers
Progress on customization docs Snip fixes and UI improvements
This commit is contained in:
Neil Toronto
parent
45b8e103e5
commit
a710cbb7fe
|
|
@ -456,14 +456,13 @@
|
|||
[((length vs) . < . 3) default-normal]
|
||||
[else
|
||||
(let ([vs (append vs (take vs 2))])
|
||||
(let/ec break
|
||||
(for ([v1 (in-list vs)]
|
||||
[v2 (in-list (rest vs))]
|
||||
[v3 (in-list (rest (rest vs)))])
|
||||
(define norm (vcross (v- v3 v2) (v- v1 v2)))
|
||||
(define m (vmag norm))
|
||||
(when (m . > . 0) (break (v/ norm m))))
|
||||
default-normal))])))
|
||||
(define norm
|
||||
(for/fold ([norm (vector 0.0 0.0 0.0)]) ([v1 (in-list vs)]
|
||||
[v2 (in-list (rest vs))]
|
||||
[v3 (in-list (rest (rest vs)))])
|
||||
(v+ norm (vcross (v- v3 v2) (v- v1 v2)))))
|
||||
(define m (vmag norm))
|
||||
(if (m . > . 0) (v/ norm m) default-normal))])))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Intervals
|
||||
|
|
|
|||
|
|
@ -35,13 +35,13 @@
|
|||
(defproc (z-ticks [ts (listof tick?)] [#:far? far? boolean? #f]) non-renderer?
|
||||
(non-renderer #f #f (z-ticks-fun ts far?)))
|
||||
|
||||
(defproc (invisible-box [x-min (or/c regular-real? #f)] [x-max (or/c regular-real? #f)]
|
||||
[y-min (or/c regular-real? #f)] [y-max (or/c regular-real? #f)]
|
||||
) non-renderer?
|
||||
(defproc (invisible-rect [x-min (or/c regular-real? #f)] [x-max (or/c regular-real? #f)]
|
||||
[y-min (or/c regular-real? #f)] [y-max (or/c regular-real? #f)]
|
||||
) non-renderer?
|
||||
(non-renderer (vector (ivl x-min x-max) (ivl y-min y-max)) #f #f))
|
||||
|
||||
(defproc (invisible-box3d [x-min (or/c regular-real? #f)] [x-max (or/c regular-real? #f)]
|
||||
[y-min (or/c regular-real? #f)] [y-max (or/c regular-real? #f)]
|
||||
[z-min (or/c regular-real? #f)] [z-max (or/c regular-real? #f)]
|
||||
) non-renderer?
|
||||
(defproc (invisible-rect3d [x-min (or/c regular-real? #f)] [x-max (or/c regular-real? #f)]
|
||||
[y-min (or/c regular-real? #f)] [y-max (or/c regular-real? #f)]
|
||||
[z-min (or/c regular-real? #f)] [z-max (or/c regular-real? #f)]
|
||||
) non-renderer?
|
||||
(non-renderer (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f #f))
|
||||
|
|
|
|||
|
|
@ -118,10 +118,11 @@
|
|||
(send dc set-background old-background)
|
||||
(send dc set-alpha old-alpha))
|
||||
|
||||
(define/public (reset-drawing-params)
|
||||
(define/public (reset-drawing-params [clipping-rect? #t])
|
||||
(send dc set-smoothing 'smoothed)
|
||||
(send dc set-text-mode 'transparent)
|
||||
(send dc set-clipping-rect dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
(when clipping-rect?
|
||||
(send dc set-clipping-rect dc-x-min dc-y-min dc-x-size dc-y-size))
|
||||
(set-font (plot-font-size) (plot-font-family))
|
||||
(set-text-foreground (plot-foreground))
|
||||
(set-pen (plot-foreground) (plot-line-width) 'solid)
|
||||
|
|
|
|||
|
|
@ -154,3 +154,48 @@
|
|||
(unless (and d-max (d . <= . d-max)) (set! d-max d)))
|
||||
d)))))
|
||||
(3d-sample xs ys zs dsss d-min d-max))))))
|
||||
|
||||
(define-syntax-rule (for-2d-sample (xa xb ya yb z1 z2 z3 z4) sample expr ...)
|
||||
(let ()
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max) sample)
|
||||
(define ya (first ys))
|
||||
(define zs0 (vector-ref zss 0))
|
||||
(for/fold ([ya ya] [zs0 zs0]) ([yb (in-list (rest ys))]
|
||||
[zs1 (in-vector zss 1)])
|
||||
(define xa (first xs))
|
||||
(define z1 (vector-ref zs0 0))
|
||||
(define z4 (vector-ref zs1 0))
|
||||
(for/fold ([xa xa] [z1 z1] [z4 z4]) ([xb (in-list (rest xs))]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)])
|
||||
expr ...
|
||||
(values xb z2 z3))
|
||||
(values yb zs1))))
|
||||
|
||||
(define-syntax-rule (for-3d-sample (xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8) sample expr ...)
|
||||
(let ()
|
||||
(match-define (3d-sample xs ys zs dsss fd-min fd-max) sample)
|
||||
(define za (first zs))
|
||||
(define dss0 (vector-ref dsss 0))
|
||||
(for/fold ([za za] [dss0 dss0]) ([zb (in-list (rest zs))]
|
||||
[dss1 (in-vector dsss 1)])
|
||||
(define ya (first ys))
|
||||
(define ds00 (vector-ref dss0 0))
|
||||
(define ds10 (vector-ref dss1 0))
|
||||
(for/fold ([ya ya] [ds00 ds00] [ds10 ds10]) ([yb (in-list (rest ys))]
|
||||
[ds01 (in-vector dss0 1)]
|
||||
[ds11 (in-vector dss1 1)])
|
||||
(define xa (first xs))
|
||||
(define d1 (vector-ref ds00 0))
|
||||
(define d4 (vector-ref ds01 0))
|
||||
(define d5 (vector-ref ds10 0))
|
||||
(define d8 (vector-ref ds11 0))
|
||||
(for/fold ([xa xa] [d1 d1] [d4 d4] [d5 d5] [d8 d8]) ([xb (in-list (rest xs))]
|
||||
[d2 (in-vector ds00 1)]
|
||||
[d3 (in-vector ds01 1)]
|
||||
[d6 (in-vector ds10 1)]
|
||||
[d7 (in-vector ds11 1)])
|
||||
expr ...
|
||||
(values xb d2 d3 d6 d7))
|
||||
(values yb ds01 ds11))
|
||||
(values zb dss1))))
|
||||
|
|
|
|||
|
|
@ -26,4 +26,5 @@
|
|||
make-3d-function->sampler)
|
||||
(contract-out (struct mapped-function ([f (any/c . -> . any/c)]
|
||||
[fmap ((listof any/c) . -> . (listof any/c))])))
|
||||
map*)
|
||||
map*
|
||||
for-2d-sample for-3d-sample)
|
||||
|
|
|
|||
|
|
@ -17,7 +17,8 @@
|
|||
"common/draw.rkt"
|
||||
"common/date-time.rkt"
|
||||
"common/marching-squares.rkt"
|
||||
"common/marching-cubes.rkt")
|
||||
"common/marching-cubes.rkt"
|
||||
"common/legend.rkt")
|
||||
|
||||
(provide (only-doc-out
|
||||
(combine-out (all-from-out "common/parameters.rkt")
|
||||
|
|
@ -32,7 +33,8 @@
|
|||
(all-from-out "common/draw.rkt")
|
||||
(all-from-out "common/date-time.rkt")
|
||||
(all-from-out "common/marching-squares.rkt")
|
||||
(all-from-out "common/marching-cubes.rkt"))))
|
||||
(all-from-out "common/marching-cubes.rkt")
|
||||
(all-from-out "common/legend.rkt"))))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; 2D exports
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
datetime->real)
|
||||
|
||||
(require "common/non-renderer.rkt")
|
||||
(provide (activate-contract-out x-ticks y-ticks z-ticks invisible-box invisible-box3d))
|
||||
(provide (activate-contract-out x-ticks y-ticks z-ticks invisible-rect invisible-rect3d))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; 2D exports
|
||||
|
|
|
|||
|
|
@ -14,25 +14,17 @@
|
|||
|
||||
(define ((isoline-render-proc g z samples color width style alpha label) area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss z-min z-max)
|
||||
(g x-min x-max samples y-min y-max samples))
|
||||
(define sample (g x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
(match-define (2d-sample xs ys zss z-min z-max) sample)
|
||||
|
||||
(when (<= z-min z z-max)
|
||||
(send area put-alpha alpha)
|
||||
(send area put-pen color width style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for/list ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(send/apply area put-line (map (λ (v) (vector-take v 2)) line)))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for/list ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(send/apply area put-line (map (λ (v) (vector-take v 2)) line)))))
|
||||
|
||||
(cond [label (line-legend-entry label color width style)]
|
||||
[else empty]))
|
||||
|
|
@ -60,9 +52,9 @@
|
|||
(define ((contours-render-proc g levels samples colors widths styles alphas label) area)
|
||||
(let/ec return
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss z-min z-max)
|
||||
(g x-min x-max samples y-min y-max samples))
|
||||
|
||||
(define sample (g x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
(match-define (2d-sample xs ys zss z-min z-max) sample)
|
||||
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #f))
|
||||
|
||||
(let ([colors (maybe-apply colors zs)]
|
||||
|
|
@ -76,20 +68,11 @@
|
|||
[alpha (in-cycle alphas)])
|
||||
(send area put-alpha alpha)
|
||||
(send area put-pen color width style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for/list ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) (map (λ (v) (vector-take v 2)) line))
|
||||
(send area put-line v1 v2))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for/list ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) (map (λ (v) (vector-take v 2)) line))
|
||||
(send area put-line v1 v2))))
|
||||
|
||||
(cond [label (line-legend-entries label zs labels colors widths styles)]
|
||||
[else empty]))))
|
||||
|
|
@ -120,9 +103,9 @@
|
|||
area)
|
||||
(let/ec return
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss z-min z-max)
|
||||
(g x-min x-max samples y-min y-max samples))
|
||||
|
||||
(define sample (g x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
(match-define (2d-sample xs ys zss z-min z-max) sample)
|
||||
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #t))
|
||||
|
||||
(define-values (z-ivls ivl-labels)
|
||||
|
|
@ -132,6 +115,7 @@
|
|||
[lb (in-list (rest labels))])
|
||||
(values (ivl za zb) (format "[~a,~a]" la lb))))
|
||||
|
||||
(send area put-pen 0 1 'transparent)
|
||||
(let ([colors (map ->brush-color (maybe-apply colors z-ivls))]
|
||||
[styles (map ->brush-style (maybe-apply styles z-ivls))]
|
||||
[alphas (maybe-apply alphas z-ivls)])
|
||||
|
|
@ -140,27 +124,12 @@
|
|||
[color (in-cycle colors)]
|
||||
[style (in-cycle styles)]
|
||||
[alpha (in-cycle alphas)])
|
||||
(define polys
|
||||
(append*
|
||||
(for/list ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for/list ([poly (in-list (heights->polys xa xb ya yb za zb z1 z2 z3 z4))])
|
||||
(map (λ (v) (vector-take v 2)) poly)))))
|
||||
|
||||
(send area put-pen color 1 'transparent)
|
||||
(send area put-brush color style)
|
||||
(send area put-alpha alpha)
|
||||
(for ([poly (in-list polys)])
|
||||
(send area put-polygon poly)))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for/list ([poly (in-list (heights->polys xa xb ya yb za zb z1 z2 z3 z4))])
|
||||
(send area put-polygon (map (λ (v) (vector-take v 2)) poly)))))
|
||||
|
||||
((contours-render-proc g levels samples contour-colors contour-widths contour-styles alphas #f)
|
||||
area)
|
||||
|
|
|
|||
|
|
@ -13,28 +13,19 @@
|
|||
(define ((isoline3d-render-proc f z samples color width style alpha label) area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max)
|
||||
(f x-min x-max (animated-samples samples) y-min y-max (animated-samples samples)))
|
||||
(define sample (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
|
||||
(when (<= z-min z z-max)
|
||||
(send area put-alpha alpha)
|
||||
(send area put-pen color width style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) line)
|
||||
(define center (vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-line v1 v2 center))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) line)
|
||||
(define center (vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-line v1 v2 center))))
|
||||
|
||||
(cond [label (line-legend-entry label color width style)]
|
||||
[else empty]))
|
||||
|
|
@ -67,9 +58,8 @@
|
|||
(define ((contours3d-render-proc f levels samples colors widths styles alphas label) area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max)
|
||||
(f x-min x-max (animated-samples samples) y-min y-max (animated-samples samples)))
|
||||
|
||||
(define sample (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #f))
|
||||
|
||||
(let ([colors (maybe-apply colors zs)]
|
||||
|
|
@ -83,22 +73,13 @@
|
|||
[alpha (in-cycle alphas)])
|
||||
(send area put-alpha alpha)
|
||||
(send area put-pen color width style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) line)
|
||||
(define center (vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-line v1 v2 center))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for ([line (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
|
||||
(match-define (list v1 v2) line)
|
||||
(define center (vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-line v1 v2 center))))
|
||||
|
||||
(cond [label (line-legend-entries label zs labels colors widths styles)]
|
||||
[else empty])))
|
||||
|
|
@ -134,8 +115,8 @@
|
|||
area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max)
|
||||
(f x-min x-max (animated-samples samples) y-min y-max (animated-samples samples)))
|
||||
(define sample (f x-min x-max (animated-samples samples) y-min y-max (animated-samples samples)))
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max) sample)
|
||||
|
||||
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #t))
|
||||
|
||||
|
|
@ -163,22 +144,13 @@
|
|||
(send area put-alpha alpha)
|
||||
(send area put-pen line-color line-width line-style)
|
||||
(send area put-brush color style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(for ([poly (in-list (heights->polys xa xb ya yb za zb z1 z2 z3 z4))])
|
||||
(define center (vector (* 1/2 (+ xa xb))
|
||||
(* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-polygon poly center))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(for ([poly (in-list (heights->polys xa xb ya yb za zb z1 z2 z3 z4))])
|
||||
(define center (vector (* 1/2 (+ xa xb))
|
||||
(* 1/2 (+ ya yb))
|
||||
(* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
|
||||
(send area put-polygon poly center))))
|
||||
|
||||
((contours3d-render-proc f levels samples contour-colors contour-widths contour-styles alphas #f)
|
||||
area)
|
||||
|
|
|
|||
|
|
@ -14,41 +14,20 @@
|
|||
area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (3d-sample xs ys zs dsss d-min d-max)
|
||||
(f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(define sample (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(match-define (3d-sample xs ys zs dsss d-min d-max) sample)
|
||||
|
||||
(send area put-alpha alpha)
|
||||
(send area put-brush color style)
|
||||
(send area put-pen line-color line-width line-style)
|
||||
(for ([za (in-list zs)]
|
||||
[zb (in-list (rest zs))]
|
||||
[dss0 (in-vector dsss)]
|
||||
[dss1 (in-vector dsss 1)]
|
||||
#:when #t
|
||||
[ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[ds00 (in-vector dss0)]
|
||||
[ds01 (in-vector dss0 1)]
|
||||
[ds10 (in-vector dss1)]
|
||||
[ds11 (in-vector dss1 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[d1 (in-vector ds00)]
|
||||
[d2 (in-vector ds00 1)]
|
||||
[d3 (in-vector ds01 1)]
|
||||
[d4 (in-vector ds01)]
|
||||
[d5 (in-vector ds10)]
|
||||
[d6 (in-vector ds10 1)]
|
||||
[d7 (in-vector ds11 1)]
|
||||
[d8 (in-vector ds11)])
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb d d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb))))))
|
||||
(for-3d-sample
|
||||
(xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8) sample
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb d d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb))))))
|
||||
|
||||
(cond [label (rectangle-legend-entry
|
||||
label color style line-color line-width line-style)]
|
||||
|
|
@ -83,10 +62,10 @@
|
|||
area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (3d-sample xs ys zs dsss fd-min fd-max)
|
||||
(f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(define sample (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(match-define (3d-sample xs ys zs dsss fd-min fd-max) sample)
|
||||
|
||||
(define d-min (if rd-min rd-min fd-min))
|
||||
(define d-max (if rd-max rd-max fd-max))
|
||||
|
|
@ -113,32 +92,12 @@
|
|||
(send area put-alpha alpha)
|
||||
(send area put-brush color style)
|
||||
(send area put-pen line-color line-width line-style)
|
||||
(for ([za (in-list zs)]
|
||||
[zb (in-list (rest zs))]
|
||||
[dss0 (in-vector dsss)]
|
||||
[dss1 (in-vector dsss 1)]
|
||||
#:when #t
|
||||
[ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[ds00 (in-vector dss0)]
|
||||
[ds01 (in-vector dss0 1)]
|
||||
[ds10 (in-vector dss1)]
|
||||
[ds11 (in-vector dss1 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[d1 (in-vector ds00)]
|
||||
[d2 (in-vector ds00 1)]
|
||||
[d3 (in-vector ds01 1)]
|
||||
[d4 (in-vector ds01)]
|
||||
[d5 (in-vector ds10)]
|
||||
[d6 (in-vector ds10 1)]
|
||||
[d7 (in-vector ds11 1)]
|
||||
[d8 (in-vector ds11)])
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb d d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb)))))))
|
||||
(for-3d-sample
|
||||
(xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8) sample
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb d d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb)))))))
|
||||
|
||||
(cond
|
||||
[label (rectangle-legend-entries
|
||||
|
|
@ -173,56 +132,37 @@
|
|||
area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (3d-sample xs ys zs dsss d-min d-max)
|
||||
(g x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(define sample (g x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)
|
||||
z-min z-max (animated-samples samples)))
|
||||
(match-define (3d-sample xs ys zs dsss d-min d-max) sample)
|
||||
|
||||
(define (draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8)
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb 0.0 d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb))))))
|
||||
|
||||
(send area put-alpha alpha)
|
||||
(send area put-brush color style)
|
||||
(send area put-pen line-color line-width line-style)
|
||||
(for ([za (in-list zs)]
|
||||
[zb (in-list (rest zs))]
|
||||
[dss0 (in-vector dsss)]
|
||||
[dss1 (in-vector dsss 1)]
|
||||
#:when #t
|
||||
[ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[ds00 (in-vector dss0)]
|
||||
[ds01 (in-vector dss0 1)]
|
||||
[ds10 (in-vector dss1)]
|
||||
[ds11 (in-vector dss1 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[d1 (in-vector ds00)]
|
||||
[d2 (in-vector ds00 1)]
|
||||
[d3 (in-vector ds01 1)]
|
||||
[d4 (in-vector ds01)]
|
||||
[d5 (in-vector ds10)]
|
||||
[d6 (in-vector ds10 1)]
|
||||
[d7 (in-vector ds11 1)]
|
||||
[d8 (in-vector ds11)])
|
||||
(define (draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8)
|
||||
(define polys (heights->cube-polys xa xb ya yb za zb 0.0 d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(when (not (empty? polys))
|
||||
(send area put-polygons polys
|
||||
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb))))))
|
||||
(cond [(and (xb . > . 0) (ya . < . 0) (yb . > . 0))
|
||||
(let* ([yb -0.00001]
|
||||
[d3 (f xb yb za)]
|
||||
[d4 (f xa yb za)]
|
||||
[d7 (f xb yb zb)]
|
||||
[d8 (f xa yb zb)])
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(let* ([ya 0.00001]
|
||||
[d1 (f xa ya za)]
|
||||
[d2 (f xb ya za)]
|
||||
[d5 (f xa ya zb)]
|
||||
[d6 (f xb ya zb)])
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8))]
|
||||
[else
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8)]))
|
||||
(for-3d-sample
|
||||
(xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8) sample
|
||||
(cond [(and (xb . > . 0) (ya . < . 0) (yb . > . 0))
|
||||
(let* ([yb -0.00001]
|
||||
[d3 (f xb yb za)]
|
||||
[d4 (f xa yb za)]
|
||||
[d7 (f xb yb zb)]
|
||||
[d8 (f xa yb zb)])
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8))
|
||||
(let* ([ya 0.00001]
|
||||
[d1 (f xa ya za)]
|
||||
[d2 (f xb ya za)]
|
||||
[d5 (f xa ya zb)]
|
||||
[d6 (f xb ya zb)])
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8))]
|
||||
[else
|
||||
(draw-cube xa xb ya yb za zb d1 d2 d3 d4 d5 d6 d7 d8)]))
|
||||
|
||||
(cond [label (rectangle-legend-entry
|
||||
label color style line-color line-width line-style)]
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
;; A small rotation matrix library, used to transform plot coordinates into view coordinates.
|
||||
|
||||
(require racket/match
|
||||
(require racket/match racket/flonum
|
||||
"../common/math.rkt")
|
||||
|
||||
(provide m3-apply m3-transpose m3* m3-rotate-z m3-rotate-x m3-scale)
|
||||
|
|
|
|||
|
|
@ -129,7 +129,9 @@
|
|||
;; coordinates.
|
||||
|
||||
(define scale-matrix (m3-scale (/ x-size) (/ y-size) (/ z-size)))
|
||||
(define rotation-matrix (m3* (m3-rotate-x rho) (m3-rotate-z theta)))
|
||||
(define rotate-theta-matrix (m3-rotate-z theta))
|
||||
(define rotate-rho-matrix (m3-rotate-x rho))
|
||||
(define rotation-matrix (m3* rotate-rho-matrix rotate-theta-matrix))
|
||||
(define transform-matrix (m3* rotation-matrix scale-matrix))
|
||||
|
||||
(define (plot->norm v) (m3-apply scale-matrix (center (axis-transform v))))
|
||||
|
|
@ -138,11 +140,11 @@
|
|||
|
||||
(define transform-matrix/no-rho (m3* (m3-rotate-z theta) scale-matrix))
|
||||
(define (plot->view/no-rho v) (m3-apply transform-matrix/no-rho (center (axis-transform v))))
|
||||
(define (rotate/rho v) (m3-apply rotate-rho-matrix v))
|
||||
|
||||
(define view->dc #f)
|
||||
(define (plot->dc/no-axis-trans v) (view->dc (m3-apply transform-matrix (center v))))
|
||||
(define (plot->dc* v) (view->dc (plot->view v)))
|
||||
(define (plot->dc v) (plot->dc* v))
|
||||
(define (plot->dc v) (view->dc (plot->view v)))
|
||||
|
||||
(define-values (view-x-size view-y-size view-z-size)
|
||||
(match-let ([(vector view-x-ivl view-y-ivl view-z-ivl)
|
||||
|
|
@ -208,7 +210,7 @@
|
|||
|
||||
(define near-dist^2 (sqr (* 3 (plot-line-width))))
|
||||
(define (vnear? v1 v2)
|
||||
((vmag^2 (v- (plot->dc* v1) (plot->dc* v2))) . <= . near-dist^2))
|
||||
((vmag^2 (v- (plot->dc v1) (plot->dc v2))) . <= . near-dist^2))
|
||||
|
||||
(define ((x-ticks-near? y) t1 t2)
|
||||
(vnear? (vector (pre-tick-value t1) y z-min)
|
||||
|
|
@ -257,13 +259,13 @@
|
|||
(define (y-tick-value->view y) (plot->view (vector y-axis-x y z-min)))
|
||||
(define (x-tick-value->dc x) (view->dc (x-tick-value->view x)))
|
||||
(define (y-tick-value->dc y) (view->dc (y-tick-value->view y)))
|
||||
(define (z-tick-value->dc z) (plot->dc* (vector z-axis-x z-axis-y z)))
|
||||
(define (z-tick-value->dc z) (plot->dc (vector z-axis-x z-axis-y z)))
|
||||
|
||||
(define (x-far-tick-value->view x) (plot->view (vector x x-far-axis-y z-min)))
|
||||
(define (y-far-tick-value->view y) (plot->view (vector y-far-axis-x y z-min)))
|
||||
(define (x-far-tick-value->dc x) (view->dc (x-far-tick-value->view x)))
|
||||
(define (y-far-tick-value->dc y) (view->dc (y-far-tick-value->view y)))
|
||||
(define (z-far-tick-value->dc z) (plot->dc* (vector z-far-axis-x z-far-axis-y z)))
|
||||
(define (z-far-tick-value->dc z) (plot->dc (vector z-far-axis-x z-far-axis-y z)))
|
||||
|
||||
(define (get-tick-params ticks tick-value->dc angle)
|
||||
(for/list ([t (in-list ticks)])
|
||||
|
|
@ -442,7 +444,7 @@
|
|||
'top (- (if y-axis-x-min? pi 0) (y-axis-angle))))
|
||||
|
||||
(define (get-z-label-params)
|
||||
(list (plot-z-label) (v+ (plot->dc* (vector z-axis-x z-axis-y z-max))
|
||||
(list (plot-z-label) (v+ (plot->dc (vector z-axis-x z-axis-y z-max))
|
||||
(vector 0 (- half-char-height)))
|
||||
'bottom-left 0))
|
||||
|
||||
|
|
@ -459,7 +461,7 @@
|
|||
'bottom (- (if y-axis-x-min? pi 0) (y-axis-angle))))
|
||||
|
||||
(define (get-z-far-label-params)
|
||||
(list (plot-z-far-label) (v+ (plot->dc* (vector z-far-axis-x z-far-axis-y z-max))
|
||||
(list (plot-z-far-label) (v+ (plot->dc (vector z-far-axis-x z-far-axis-y z-max))
|
||||
(vector 0 (- half-char-height)))
|
||||
'bottom-right 0))
|
||||
|
||||
|
|
@ -587,53 +589,55 @@
|
|||
(define (add-shape! shape) (set! render-list (cons shape render-list)))
|
||||
(define (add-shapes! shapes) (set! render-list (append shapes render-list)))
|
||||
|
||||
(define (draw-shapes lst)
|
||||
(for ([s (in-list (depth-sort (reverse lst) plot->view/no-rho))])
|
||||
(draw-shape s)))
|
||||
(define (draw-shapes ss)
|
||||
(define s+cs (map (λ (s) (cons s (plot->view/no-rho (shape-center s)))) ss))
|
||||
(for ([s+c (in-list (depth-sort (reverse s+cs)))])
|
||||
(match-define (cons s c) s+c)
|
||||
(draw-shape s (rotate/rho c))))
|
||||
|
||||
(define (draw-polygon alpha center vs norm pen-color pen-width pen-style brush-color brush-style)
|
||||
(define-values (diff spec) (get-light-values (plot->view center) (norm->view norm)))
|
||||
(define-values (diff spec) (get-light-values center (norm->view norm)))
|
||||
(let ([pen-color (map (λ (v) (+ (* v diff) spec)) pen-color)]
|
||||
[brush-color (map (λ (v) (+ (* v diff) spec)) brush-color)])
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd set-brush brush-color brush-style)
|
||||
(send pd draw-polygon (map (λ (v) (plot->dc v)) vs))))
|
||||
|
||||
(define (draw-shape s)
|
||||
(define (draw-shape s center)
|
||||
(send pd set-alpha (shape-alpha s))
|
||||
(match s
|
||||
;; shapes
|
||||
[(shapes alpha center ss) (draw-shapes ss)]
|
||||
[(shapes alpha _ ss) (draw-shapes ss)]
|
||||
;; polygon
|
||||
[(polygon alpha center vs norm pen-color pen-width pen-style brush-color brush-style)
|
||||
[(polygon alpha _ vs norm pen-color pen-width pen-style brush-color brush-style)
|
||||
(draw-polygon alpha center vs norm pen-color pen-width pen-style brush-color brush-style)]
|
||||
;; rectangle
|
||||
[(rectangle alpha center r pen-color pen-width pen-style brush-color brush-style)
|
||||
[(rectangle alpha _ r pen-color pen-width pen-style brush-color brush-style)
|
||||
(for ([face (in-list (rect-visible-faces r theta))])
|
||||
(match face
|
||||
[(list norm vs ...) (draw-polygon alpha center vs norm pen-color pen-width pen-style
|
||||
brush-color brush-style)]
|
||||
[_ (void)]))]
|
||||
;; line
|
||||
[(line alpha center v1 v2 pen-color pen-width pen-style)
|
||||
[(line alpha _ v1 v2 pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-line (plot->dc v1) (plot->dc v2))]
|
||||
;; text
|
||||
[(text alpha center anchor angle str font-size font-family color)
|
||||
[(text alpha _ anchor angle str font-size font-family color)
|
||||
(send pd set-font font-size font-family)
|
||||
(send pd set-text-foreground color)
|
||||
(send pd draw-text str (plot->dc center) anchor angle)]
|
||||
(send pd draw-text str (view->dc center) anchor angle)]
|
||||
;; glyph
|
||||
[(glyph alpha center symbol size pen-color pen-width pen-style brush-color brush-style)
|
||||
[(glyph alpha _ symbol size pen-color pen-width pen-style brush-color brush-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd set-brush brush-color brush-style)
|
||||
(send pd draw-glyphs (list (plot->dc center)) symbol size)]
|
||||
(send pd draw-glyphs (list (view->dc center)) symbol size)]
|
||||
;; tick glyph
|
||||
[(tick-glyph alpha center radius angle pen-color pen-width pen-style)
|
||||
[(tick-glyph alpha _ radius angle pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-tick (plot->dc center) radius angle)]
|
||||
(send pd draw-tick (view->dc center) radius angle)]
|
||||
;; arrow glyph
|
||||
[(arrow-glyph alpha center v1 v2 pen-color pen-width pen-style)
|
||||
[(arrow-glyph alpha _ v1 v2 pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-arrow (plot->dc v1) (plot->dc v2))]
|
||||
[_ (error 'draw-shapes "shape not implemented: ~e" s)]))
|
||||
|
|
@ -702,34 +706,6 @@
|
|||
(draw-ticks (get-front-tick-params))
|
||||
(draw-labels (get-front-label-params)))
|
||||
|
||||
(define (draw-angles*)
|
||||
(define angle-str (format " angle = ~a " (number->string (round angle))))
|
||||
(define alt-str (format " altitude = ~a " (number->string (round altitude))))
|
||||
(define-values (angle-width angle-height baseline _angle2) (send pd get-text-extent angle-str))
|
||||
(define-values (alt-width alt-height _alt1 _alt2) (send pd get-text-extent alt-str))
|
||||
|
||||
(define box-x-size (max angle-width alt-width))
|
||||
(define box-y-size (+ angle-height alt-height (* 3 baseline)))
|
||||
(define box-x-min (+ dc-x-min (* 1/2 (- dc-x-size box-x-size))))
|
||||
(define box-y-min (+ dc-y-min (* 1/2 (- dc-y-size box-y-size))))
|
||||
(define box-x-max (+ box-x-min box-x-size))
|
||||
(define box-y-max (+ box-y-min box-y-size))
|
||||
|
||||
(send pd set-alpha 1/2)
|
||||
(send pd set-minor-pen)
|
||||
(send pd set-brush (plot-background) 'solid)
|
||||
(send pd draw-rect (vector (ivl box-x-min box-x-max) (ivl box-y-min box-y-max)))
|
||||
|
||||
(send pd set-alpha 1)
|
||||
(send pd draw-text
|
||||
angle-str (vector box-x-min (+ box-y-min baseline))
|
||||
'top-left #:outline? #t)
|
||||
(send pd draw-text
|
||||
alt-str (vector box-x-min (+ box-y-min baseline char-height))
|
||||
'top-left #:outline? #t))
|
||||
|
||||
(define/public (draw-angles) (draw-angles*))
|
||||
|
||||
(define (draw-legend* legend-entries)
|
||||
(define gap-size (+ (pen-gap) tick-radius))
|
||||
(send pd draw-legend legend-entries
|
||||
|
|
@ -820,7 +796,7 @@
|
|||
(add-shape! (line alpha c v1 v2
|
||||
pen-color pen-width pen-style))]
|
||||
[else
|
||||
(define vs (subdivide-line plot->dc* v1 v2))
|
||||
(define vs (subdivide-line plot->dc v1 v2))
|
||||
(for ([v1 (in-list vs)] [v2 (in-list (rest vs))])
|
||||
(add-shape! (line alpha c v1 v2 pen-color pen-width pen-style)))]))))
|
||||
|
||||
|
|
@ -841,7 +817,7 @@
|
|||
clip-y-min clip-y-max
|
||||
clip-z-min clip-z-max)
|
||||
vs)]
|
||||
[vs (if identity-transforms? vs (subdivide-polygon plot->dc* vs))])
|
||||
[vs (if identity-transforms? vs (subdivide-polygon plot->dc vs))])
|
||||
(when (empty? vs) (return lst))
|
||||
(cons (polygon alpha c vs norm pen-color pen-width pen-style brush-color brush-style)
|
||||
lst))))
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
(rect-zero-area? plot-bounds-rect))
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) plot-bounds-rect)
|
||||
(error 'plot "could not determine sensible plot bounds; got x ∈ [~a,~a], y ∈ [~a,~a], z ∈ [~a,~a]"
|
||||
x-min x-max y-min y-max z-min z-max))
|
||||
x-min x-max y-min y-max z-min z-max))
|
||||
|
||||
(rect-inexact->exact plot-bounds-rect))
|
||||
|
||||
|
|
@ -80,15 +80,11 @@
|
|||
|
||||
(send area end-renderers)
|
||||
|
||||
(when (and (not (empty? legend-entries))
|
||||
(or (not (plot-animating?))
|
||||
(not (equal? (plot-legend-anchor) 'center))))
|
||||
(when (not (empty? legend-entries))
|
||||
(send area draw-legend legend-entries))
|
||||
|
||||
(when (plot-animating?) (send area draw-angles))
|
||||
|
||||
(send area end-plot))
|
||||
|
||||
|
||||
|
||||
(defproc (plot3d/dc [renderer-tree (treeof (or/c renderer3d? non-renderer?))]
|
||||
[dc (is-a?/c dc<%>)]
|
||||
|
|
@ -167,9 +163,9 @@
|
|||
[#:z-label z-label (or/c string? #f) (plot-z-label)]
|
||||
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
|
||||
) pict?
|
||||
(define saved-values (plot-parameters))
|
||||
(define saved-plot-parameters (plot-parameters))
|
||||
(dc (λ (dc x y)
|
||||
(parameterize/group ([plot-parameters saved-values])
|
||||
(parameterize/group ([plot-parameters saved-plot-parameters])
|
||||
(plot3d/dc renderer-tree dc x y width height
|
||||
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:z-min z-min
|
||||
#:z-max z-max #:angle angle #:altitude altitude #:title title #:x-label x-label
|
||||
|
|
@ -194,57 +190,54 @@
|
|||
[#:z-label z-label (or/c string? #f) (plot-z-label)]
|
||||
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
|
||||
) (is-a?/c image-snip%)
|
||||
(define renderer-list (get-renderer-list renderer-tree))
|
||||
(define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max z-min z-max))
|
||||
(define-values (x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks)
|
||||
(get-ticks renderer-list bounds-rect))
|
||||
|
||||
(define render-list-hash (make-hash))
|
||||
(define legend-entries-hash (make-hash))
|
||||
|
||||
(make-3d-plot-snip
|
||||
(λ (anim? angle altitude)
|
||||
(parameterize ([plot-animating? (if anim? #t (plot-animating?))]
|
||||
[plot3d-angle angle]
|
||||
[plot3d-altitude altitude]
|
||||
[plot-title title]
|
||||
[plot-x-label x-label]
|
||||
[plot-y-label y-label]
|
||||
[plot-z-label z-label]
|
||||
[plot-legend-anchor legend-anchor])
|
||||
((if (plot-animating?) draw-bitmap draw-bitmap/supersampling)
|
||||
(λ (dc)
|
||||
(define area (make-object 3d-plot-area%
|
||||
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks
|
||||
dc 0 0 width height))
|
||||
(send area start-plot)
|
||||
|
||||
(cond [(not (hash-ref render-list-hash (plot-animating?) #f))
|
||||
(hash-set!
|
||||
legend-entries-hash (plot-animating?)
|
||||
(flatten (for/list ([rend (in-list renderer-list)])
|
||||
(match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
|
||||
(send area start-renderer (cond [rend-bounds-rect rend-bounds-rect]
|
||||
[else (empty-rect 3)]))
|
||||
(if render-proc (render-proc area) empty))))
|
||||
|
||||
(hash-set! render-list-hash (plot-animating?) (send area get-render-list))]
|
||||
[else
|
||||
(send area put-render-list (hash-ref render-list-hash (plot-animating?)))])
|
||||
|
||||
(send area end-renderers)
|
||||
|
||||
(define legend-entries (hash-ref legend-entries-hash (plot-animating?) #f))
|
||||
(when (and (not (empty? legend-entries))
|
||||
(or (not (plot-animating?))
|
||||
(not (equal? (plot-legend-anchor) 'center))))
|
||||
(send area draw-legend legend-entries))
|
||||
|
||||
(when (plot-animating?) (send area draw-angles))
|
||||
|
||||
(send area end-plot))
|
||||
width height)))
|
||||
angle altitude))
|
||||
(parameterize ([plot-title title]
|
||||
[plot-x-label x-label]
|
||||
[plot-y-label y-label]
|
||||
[plot-z-label z-label]
|
||||
[plot-legend-anchor legend-anchor])
|
||||
(define saved-plot-parameters (plot-parameters))
|
||||
(define renderer-list (get-renderer-list renderer-tree))
|
||||
(define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max z-min z-max))
|
||||
(define-values (x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks)
|
||||
(get-ticks renderer-list bounds-rect))
|
||||
|
||||
(define render-list-hash (make-hash))
|
||||
(define legend-entries-hash (make-hash))
|
||||
|
||||
(make-3d-plot-snip
|
||||
(λ (anim? angle altitude)
|
||||
(parameterize ([plot-animating? (if anim? #t (plot-animating?))]
|
||||
[plot3d-angle angle]
|
||||
[plot3d-altitude altitude])
|
||||
((if (plot-animating?) draw-bitmap draw-bitmap/supersampling)
|
||||
(λ (dc)
|
||||
(define area (make-object 3d-plot-area%
|
||||
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks
|
||||
dc 0 0 width height))
|
||||
(send area start-plot)
|
||||
|
||||
(cond [(not (hash-ref render-list-hash (plot-animating?) #f))
|
||||
(hash-set!
|
||||
legend-entries-hash (plot-animating?)
|
||||
(flatten (for/list ([rend (in-list renderer-list)])
|
||||
(match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
|
||||
(send area start-renderer (cond [rend-bounds-rect rend-bounds-rect]
|
||||
[else (empty-rect 3)]))
|
||||
(if render-proc (render-proc area) empty))))
|
||||
|
||||
(hash-set! render-list-hash (plot-animating?) (send area get-render-list))]
|
||||
[else
|
||||
(send area put-render-list (hash-ref render-list-hash (plot-animating?)))])
|
||||
|
||||
(send area end-renderers)
|
||||
|
||||
(define legend-entries (hash-ref legend-entries-hash (plot-animating?) #f))
|
||||
(when (not (empty? legend-entries))
|
||||
(send area draw-legend legend-entries))
|
||||
|
||||
(send area end-plot))
|
||||
width height)))
|
||||
angle altitude saved-plot-parameters)))
|
||||
|
||||
;; Plot to a frame
|
||||
(defproc (plot3d-frame [renderer-tree (treeof (or/c renderer3d? non-renderer?))]
|
||||
|
|
|
|||
|
|
@ -17,14 +17,13 @@
|
|||
(struct shapes shape (list) #:transparent)
|
||||
|
||||
(define (draw-before? cs1 cs2)
|
||||
(match-define (cons (vector x1 y1 z1) s1) cs1)
|
||||
(match-define (cons (vector x2 y2 z2) s2) cs2)
|
||||
(match-define (cons s1 (vector x1 y1 z1)) cs1)
|
||||
(match-define (cons s2 (vector x2 y2 z2)) cs2)
|
||||
(or (y1 . > . y2)
|
||||
(and (y1 . = . y2)
|
||||
(if (z1 . = . z2)
|
||||
(and (polygon? s1) (not (polygon? s2)))
|
||||
(z1 . < . z2)))))
|
||||
|
||||
(define (depth-sort shapes f)
|
||||
(map cdr (sort (map (λ (s) (cons (f (shape-center s)) s)) shapes)
|
||||
draw-before?)))
|
||||
(define (depth-sort s+cs)
|
||||
(sort s+cs draw-before?))
|
||||
|
|
|
|||
|
|
@ -1,35 +1,40 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/gui/base racket/class racket/match racket/list
|
||||
(require racket/gui/base racket/class racket/match racket/list unstable/parameter-group
|
||||
"../common/gui.rkt"
|
||||
"../common/math.rkt"
|
||||
"../common/worker-thread.rkt"
|
||||
"../common/plot-device.rkt"
|
||||
"../common/parameters.rkt"
|
||||
"plot-area.rkt")
|
||||
|
||||
(provide 3d-plot-snip% make-3d-plot-snip)
|
||||
|
||||
(define update-delay 33) ; about 30 fps (just over)
|
||||
(define update-delay 16) ; about 60 fps (just over)
|
||||
(define message-timeout 2000)
|
||||
|
||||
(struct draw-command (animating? angle altitude) #:transparent)
|
||||
(struct copy-command () #:transparent)
|
||||
|
||||
(define (make-render-thread make-bm)
|
||||
(define (make-render-thread make-bm saved-plot-parameters)
|
||||
(make-worker-thread
|
||||
(match-lambda
|
||||
[(draw-command animating? angle altitude) (make-bm animating? angle altitude)]
|
||||
[(copy-command) (make-render-thread make-bm)])))
|
||||
[(draw-command animating? angle altitude)
|
||||
(parameterize/group ([plot-parameters saved-plot-parameters])
|
||||
(make-bm animating? angle altitude))])))
|
||||
|
||||
(define (clamp x mn mx) (min* (max* x mn) mx))
|
||||
|
||||
(define 3d-plot-snip%
|
||||
(class image-snip%
|
||||
(init-field make-bm angle altitude
|
||||
[bm (make-bm #f angle altitude)]
|
||||
[rth (make-render-thread make-bm)])
|
||||
(init-field make-bm angle altitude saved-plot-parameters
|
||||
[bm (make-bm #f angle altitude)])
|
||||
(inherit set-bitmap)
|
||||
|
||||
(super-make-object bm)
|
||||
|
||||
(define/override (copy)
|
||||
(make-object this% make-bm angle altitude saved-plot-parameters bm))
|
||||
|
||||
(define width (send bm get-width))
|
||||
(define height (send bm get-height))
|
||||
|
||||
|
|
@ -41,73 +46,161 @@
|
|||
(define (new-angle) (real-modulo (+ angle (* (- left-drag-x left-click-x) (/ 180 width))) 360))
|
||||
(define (new-altitude) (clamp (+ altitude (* (- left-drag-y left-click-y) (/ 180 height))) 0 90))
|
||||
|
||||
(define draw? #t)
|
||||
(define timer #f)
|
||||
(define (refresh)
|
||||
;(printf "refreshing ~a~n" (current-milliseconds))
|
||||
(send this set-bitmap bm))
|
||||
|
||||
(define ((update animating?))
|
||||
(define draw? #t)
|
||||
(define update-timer #f)
|
||||
(define rth (make-render-thread make-bm saved-plot-parameters))
|
||||
|
||||
(define (stop-update-timer)
|
||||
(when update-timer
|
||||
(send update-timer stop)
|
||||
(set! update-timer #f)))
|
||||
|
||||
(define (start-update-timer)
|
||||
(stop-update-timer)
|
||||
(set! update-timer (make-object timer% update update-delay)))
|
||||
|
||||
(define (update)
|
||||
;(printf "update ~a~n" (current-milliseconds))
|
||||
(define can-draw?
|
||||
(cond [(worker-thread-working? rth)
|
||||
(define new-bm (worker-thread-try-get rth))
|
||||
(cond [(is-a? new-bm bitmap%) (set! bm new-bm)
|
||||
(set-angles-message (new-angle) (new-altitude))
|
||||
(set-bitmap bm)
|
||||
#t]
|
||||
[else #f])]
|
||||
[else #t]))
|
||||
(when (and draw? can-draw?)
|
||||
(set! draw? #f)
|
||||
(worker-thread-put rth (draw-command animating? (new-angle) (new-altitude)))))
|
||||
(worker-thread-put rth (draw-command #t (new-angle) (new-altitude))))
|
||||
(refresh-message-timer))
|
||||
|
||||
(define (stop-timer)
|
||||
(when timer
|
||||
(send timer stop)
|
||||
(set! timer #f)))
|
||||
(define message #f)
|
||||
(define message-timer #f)
|
||||
|
||||
(define (start-timer)
|
||||
(stop-timer)
|
||||
(set! timer (make-object timer% (update #t) update-delay)))
|
||||
(define (stop-message)
|
||||
;(printf "stop-message ~a~n" (current-milliseconds))
|
||||
(when message-timer
|
||||
(send message-timer stop)
|
||||
(set! message-timer #f)
|
||||
(set! message #f)
|
||||
(refresh)))
|
||||
|
||||
(define (refresh-message-timer)
|
||||
(when message-timer
|
||||
(send message-timer stop))
|
||||
(set! message-timer (make-object timer% stop-message message-timeout)))
|
||||
|
||||
(define (set-message msg)
|
||||
(refresh-message-timer)
|
||||
(set! message msg))
|
||||
|
||||
(define (set-angles-message angle altitude)
|
||||
(set-message (format "angle = ~a\naltitude = ~a"
|
||||
(number->string (round angle))
|
||||
(number->string (round altitude)))))
|
||||
|
||||
(define (start-message msg)
|
||||
(define refresh? (not (equal? msg message)))
|
||||
(set-message msg)
|
||||
(when refresh? (refresh)))
|
||||
|
||||
(define dragged? #f)
|
||||
(define (start-click-message)
|
||||
(unless dragged?
|
||||
(start-message "Click and drag to rotate")))
|
||||
|
||||
(define/override (on-event dc x y editorx editory evt)
|
||||
(case (send evt get-event-type)
|
||||
(define evt-type (send evt get-event-type))
|
||||
#;(when (not (eq? evt-type 'motion))
|
||||
(printf "evt-type = ~v~n" evt-type))
|
||||
#;(when (eq? evt-type 'motion)
|
||||
(printf "motion for ~a; x,y = ~a,~a~n" (eq-hash-code this) (send evt get-x) (send evt get-y)))
|
||||
(case evt-type
|
||||
[(left-down) (worker-thread-wait rth)
|
||||
(set! angle (new-angle))
|
||||
(set! altitude (new-altitude))
|
||||
(set-angles-message angle altitude)
|
||||
(set! left-click-x (send evt get-x))
|
||||
(set! left-click-y (send evt get-y))
|
||||
(set! left-drag-x left-click-x)
|
||||
(set! left-drag-y left-click-y)
|
||||
(set! draw? #t)
|
||||
(start-timer)]
|
||||
[(left-up) (stop-timer)
|
||||
(set! draw? #f)
|
||||
(worker-thread-wait rth)
|
||||
(set! left-drag-x (send evt get-x))
|
||||
(set! left-drag-y (send evt get-y))
|
||||
(set! angle (new-angle))
|
||||
(set! altitude (new-altitude))
|
||||
(set! left-click-x 0)
|
||||
(set! left-click-y 0)
|
||||
(set! left-drag-x 0)
|
||||
(set! left-drag-y 0)
|
||||
(worker-thread-put rth (draw-command #f angle altitude))
|
||||
(define new-bm (worker-thread-get rth))
|
||||
(when (is-a? new-bm bitmap%)
|
||||
(set! bm new-bm)
|
||||
(set-bitmap bm))]
|
||||
[(motion) (when timer
|
||||
(cond [(send evt get-left-down)
|
||||
(set! left-drag-x (send evt get-x))
|
||||
(set! left-drag-y (send evt get-y))
|
||||
(set! draw? #t)]))]))
|
||||
(start-update-timer)]
|
||||
[(left-up) (when update-timer
|
||||
(stop-update-timer)
|
||||
(set! draw? #f)
|
||||
(worker-thread-wait rth)
|
||||
(set! left-drag-x (send evt get-x))
|
||||
(set! left-drag-y (send evt get-y))
|
||||
(set! angle (new-angle))
|
||||
(set! altitude (new-altitude))
|
||||
(set-angles-message angle altitude)
|
||||
(set! left-click-x 0)
|
||||
(set! left-click-y 0)
|
||||
(set! left-drag-x 0)
|
||||
(set! left-drag-y 0)
|
||||
(worker-thread-put rth (draw-command #f angle altitude))
|
||||
(define new-bm (worker-thread-get rth))
|
||||
(when (is-a? new-bm bitmap%)
|
||||
(set! bm new-bm)
|
||||
(set-bitmap bm)))]
|
||||
[(motion) (when (and update-timer (send evt get-left-down))
|
||||
(when (not (and (= left-drag-x (send evt get-x))
|
||||
(= left-drag-y (send evt get-y))))
|
||||
(set! left-drag-x (send evt get-x))
|
||||
(set! left-drag-y (send evt get-y))
|
||||
(set! draw? #t)
|
||||
(set! dragged? #t)))
|
||||
(when (and (not (send evt get-left-down))
|
||||
(<= x (send evt get-x) (+ x width))
|
||||
(<= y (send evt get-y) (+ y height)))
|
||||
(start-click-message))]))
|
||||
|
||||
(define/override (copy)
|
||||
(make-object this%
|
||||
make-bm angle altitude bm (worker-thread-send rth (copy-command))))
|
||||
(define (draw-message dc dc-x-min dc-y-min)
|
||||
(define pd (make-object plot-device% dc dc-x-min dc-y-min width height))
|
||||
(send pd reset-drawing-params #f)
|
||||
|
||||
(define lines (map (λ (line) (format " ~a " line)) (regexp-split "\n" message)))
|
||||
|
||||
(define-values (_1 char-height baseline _2) (send pd get-text-extent (first lines)))
|
||||
(define line-widths (map (λ (line) (send pd get-text-width line)) lines))
|
||||
|
||||
(define box-x-size (apply max line-widths))
|
||||
(define box-y-size (+ baseline (* (length lines) (+ char-height baseline))))
|
||||
(define box-x-min (+ dc-x-min (* 1/2 (- width box-x-size))))
|
||||
(define box-y-min (+ dc-y-min (* 1/2 (- height box-y-size))))
|
||||
(define box-x-max (+ box-x-min box-x-size))
|
||||
(define box-y-max (+ box-y-min box-y-size))
|
||||
|
||||
(send pd set-alpha 2/3)
|
||||
(send pd set-minor-pen)
|
||||
(send pd draw-rect (vector (ivl box-x-min box-x-max) (ivl box-y-min box-y-max)))
|
||||
|
||||
(send pd set-alpha 1)
|
||||
(for ([line (in-list lines)] [i (in-naturals)])
|
||||
(send pd draw-text
|
||||
line (vector box-x-min (+ box-y-min baseline (* i (+ char-height baseline))))
|
||||
'top-left #:outline? #t))
|
||||
(send pd restore-drawing-params))
|
||||
|
||||
(define/override (draw dc x y left top right bottom dx dy draw-caret)
|
||||
;(printf "drawing ~a~n" (current-milliseconds))
|
||||
(super draw dc x y left top right bottom dx dy draw-caret)
|
||||
;(send dc draw-bitmap-section bm x y 0 0 width height)
|
||||
(when message
|
||||
(parameterize/group ([plot-parameters saved-plot-parameters])
|
||||
(draw-message dc x y))))
|
||||
|
||||
(define cross-cursor (make-object cursor% 'cross))
|
||||
(define/override (adjust-cursor dc x y editorx editory evt) cross-cursor)
|
||||
|
||||
(send this set-flags (list* 'handles-events (send this get-flags)))))
|
||||
(send this set-flags (list* 'handles-events 'handles-all-mouse-events (send this get-flags)))))
|
||||
|
||||
;; make-3d-plot-snip : (real real real -> bitmap) real real -> 3d-plot-snip%
|
||||
(define (make-3d-plot-snip make-bm angle altitude)
|
||||
(make-object 3d-plot-snip% make-bm angle altitude))
|
||||
(define (make-3d-plot-snip make-bm angle altitude saved-plot-parameters)
|
||||
(make-object 3d-plot-snip% make-bm angle altitude saved-plot-parameters))
|
||||
|
|
|
|||
|
|
@ -12,25 +12,16 @@
|
|||
(define ((surface3d-render-proc f samples color style line-color line-width line-style alpha label)
|
||||
area)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) z-ivl) (send area get-bounds-rect))
|
||||
(match-define (2d-sample xs ys zss fz-min fz-max) (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
(define sample (f x-min x-max (animated-samples samples)
|
||||
y-min y-max (animated-samples samples)))
|
||||
|
||||
(send area put-alpha alpha)
|
||||
(send area put-brush color style)
|
||||
(send area put-pen line-color line-width line-style)
|
||||
(for ([ya (in-list ys)]
|
||||
[yb (in-list (rest ys))]
|
||||
[zs0 (in-vector zss)]
|
||||
[zs1 (in-vector zss 1)]
|
||||
#:when #t
|
||||
[xa (in-list xs)]
|
||||
[xb (in-list (rest xs))]
|
||||
[z1 (in-vector zs0)]
|
||||
[z2 (in-vector zs0 1)]
|
||||
[z3 (in-vector zs1 1)]
|
||||
[z4 (in-vector zs1)])
|
||||
(send area put-polygon
|
||||
(list (vector xa ya z1) (vector xb ya z2) (vector xb yb z3) (vector xa yb z4))))
|
||||
(for-2d-sample
|
||||
(xa xb ya yb z1 z2 z3 z4) sample
|
||||
(send area put-polygon
|
||||
(list (vector xa ya z1) (vector xb ya z2) (vector xb yb z3) (vector xa yb z4))))
|
||||
|
||||
(cond [label (rectangle-legend-entry label color style line-color line-width line-style)]
|
||||
[else empty]))
|
||||
|
|
|
|||
|
|
@ -2,6 +2,68 @@
|
|||
|
||||
@(require "common.rkt")
|
||||
|
||||
@title[#:tag "custom"]{Making Custom Plot Renderers}
|
||||
@title[#:tag "custom"]{Custom Plot Elements}
|
||||
|
||||
@declare-exporting[plot/utils]
|
||||
|
||||
@section{Plot Elements}
|
||||
|
||||
@defstruct[plot-element ([bounds-rect (or/c (vectorof ivl?) #f)]
|
||||
[bounds-fun (or/c bounds-fun/c #f)]
|
||||
[ticks-fun (or/c ticks-fun/c #f)])]{
|
||||
}
|
||||
|
||||
@defstruct[(non-renderer plot-element) ()]{
|
||||
Examples: @racket[x-ticks], @racket[y-ticks], @racket[z-ticks], @racket[invisible-rect] and @racket[invisible-rect3d]
|
||||
}
|
||||
|
||||
@subsection{Plot Element Bounds}
|
||||
|
||||
@doc-apply[bounds-fun/c]{
|
||||
}
|
||||
|
||||
@doc-apply[function-bounds-fun]
|
||||
@doc-apply[inverse-bounds-fun]
|
||||
@doc-apply[function-interval-bounds-fun]
|
||||
@doc-apply[inverse-interval-bounds-fun]
|
||||
@doc-apply[surface3d-bounds-fun]
|
||||
|
||||
@subsection{Plot Element Ticks}
|
||||
|
||||
@doc-apply[ticks-fun/c]{
|
||||
}
|
||||
|
||||
@doc-apply[default-ticks-fun]{
|
||||
}
|
||||
|
||||
@section{2D Renderers}
|
||||
|
||||
@defstruct[(renderer2d plot-element) ([render-proc (or/c ((is-a?/c 2d-plot-area%)
|
||||
. -> . (treeof legend-entry?))
|
||||
#f)])]{
|
||||
}
|
||||
|
||||
@section{3D Renderers}
|
||||
|
||||
@defstruct[(renderer3d plot-element) ([render-proc (or/c ((is-a?/c 3d-plot-area%)
|
||||
. -> . (treeof legend-entry?))
|
||||
#f)])]{
|
||||
}
|
||||
|
||||
@section{Legend Entries}
|
||||
|
||||
@defstruct[legend-entry ([label string?]
|
||||
[draw ((is-a?/c plot-device%) real? real? real? real?
|
||||
. -> . void?)])]{
|
||||
}
|
||||
|
||||
@doc-apply[line-legend-entry]
|
||||
@doc-apply[line-legend-entries]
|
||||
@doc-apply[rectangle-legend-entry]
|
||||
@doc-apply[rectangle-legend-entries]
|
||||
@doc-apply[interval-legend-entry]
|
||||
@doc-apply[interval-legend-entries]
|
||||
@doc-apply[point-legend-entry]
|
||||
@doc-apply[vector-field-legend-entry]
|
||||
|
||||
todo: rename vector-field-legend-entry to arrow-legend-entry?
|
||||
|
|
|
|||
|
|
@ -11,9 +11,6 @@
|
|||
@item{2D kernel density estimator}
|
||||
@item{3D kernel density estimator}
|
||||
@item{3D decorations: labeled points, axes, grids}
|
||||
@item{3D vector field}
|
||||
@item{2D and 3D stacked histograms}
|
||||
@item{2D grouped histograms}
|
||||
]
|
||||
}
|
||||
@item{Possible minor enhancements
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require plot plot/utils racket/flonum)
|
||||
(require plot plot/utils #;racket/flonum)
|
||||
|
||||
(time
|
||||
(plot3d (isosurface3d (λ (x y z) (sqrt (+ (sqr x) (sqr y) (sqr z)))) 1
|
||||
|
|
@ -48,7 +48,10 @@
|
|||
(time
|
||||
(define (f1 θ ρ) (+ 1 (/ θ 2pi) (* 1/8 (sin (* 8 ρ)))))
|
||||
(define (f2 θ ρ) (+ (/ θ 2pi) (* 1/8 (sin (* 8 ρ)))))
|
||||
|
||||
(plot3d (list (polar3d f1 #:samples 41 #:color "navajowhite" #:line-style 'transparent #:alpha 2/3)
|
||||
(polar3d f2 #:samples 41 #:color "navajowhite" #:line-style 'transparent #:alpha 2/3))
|
||||
#:title "A Seashell" #:x-label #f #:y-label #f))
|
||||
(polar3d f2 #:samples 41 #:color "navajowhite" #:line-style 'transparent #:alpha 2/3)
|
||||
(parametric3d (λ (ρ) (3d-polar->3d-cartesian 0 ρ (f1 2pi ρ)))
|
||||
(* -1/2 pi) (* 1/2 pi)
|
||||
#:color "navajowhite" #:width 2)
|
||||
(lines3d '(#(0 0 2) #(0 0 -2)) #:color "navajowhite" #:width 2))
|
||||
#:title "A Seashell" #:x-label #f #:y-label #f #:angle 210 #:altitude 30))
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@
|
|||
|
||||
(time
|
||||
(plot3d (stacked-histogram3d '(#(a a (1 1 1)) #(a b (1.5 3)) #(b b ()) #(b a (1/2)))
|
||||
#:labels '("Red" #f "Blue"))))
|
||||
#:labels '("Red" #f "Blue") #:alphas '(2/3))))
|
||||
|
||||
(time
|
||||
(plot3d (surface3d + 0 10 0 1)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user