suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Began finalizing public interface to *d-plot-area% classes

Browse Source
This commit is contained in:
Neil Toronto 2011-11-04 02:49:58 -06:00
parent a4f245b273
commit 6bed60452a
15 changed files with 135 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/plot/common/math.rkt
View File

@ -424,17 +424,7 @@
(define norm (vcross (v- v3 v2) (v- v1 v2)))
(define m (vmag norm))
(when (m . > . 0) (break (v/ norm m))))
default-normal)
#;
(begin
(define n
(for/fold ([norm (vector 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) default-normal (v/ norm m))))])))
default-normal))])))
;; ===================================================================================================
;; Intervals

18
collects/plot/compat.rkt
View File

@ -5,6 +5,7 @@
(require racket/contract racket/class racket/snip racket/draw racket/vector
unstable/latent-contract
;; Plotting
"common/math.rkt"
"common/contract.rkt"
"common/contract-doc.rkt"
"common/plot-element.rkt"
@ -76,6 +77,7 @@
) (is-a?/c image-snip%)
(define x-ticks (new.default-x-ticks x-min x-max))
(define y-ticks (new.default-y-ticks y-min y-max))
(define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max)))
(parameterize ([new.plot-title title]
[new.plot-x-label x-label]
@ -84,14 +86,13 @@
[new.plot-background bgcolor])
(define bm (make-bitmap (ceiling width) (ceiling height)))
(define dc (make-object bitmap-dc% bm))
(define area (make-object 2d-plot-area% x-ticks x-ticks y-ticks y-ticks
x-min x-max y-min y-max
dc 0 0 width height))
(define area (make-object 2d-plot-area%
bounds-rect x-ticks x-ticks y-ticks y-ticks dc 0 0 width height))
(define data+axes (mix x-axis-data y-axis-data data))
(send area start-plot)
(send area start-renderer x-min x-max y-min y-max)
(send area start-renderer bounds-rect)
(data+axes area)
(send area end-renderers)
(send area end-plot)
@ -119,6 +120,7 @@
(define x-ticks (new.default-x-ticks x-min x-max))
(define y-ticks (new.default-y-ticks y-min y-max))
(define z-ticks (new.default-z-ticks z-min z-max))
(define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)))
(parameterize ([new.plot-title title]
[new.plot-x-label x-label]
@ -130,13 +132,11 @@
[new.plot3d-altitude alt])
(define bm (make-bitmap (ceiling width) (ceiling height)))
(define dc (make-object bitmap-dc% bm))
(define area
(make-object 3d-plot-area% x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks
x-min x-max y-min y-max z-min z-max
dc 0 0 width height))
(define area (make-object 3d-plot-area%
bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks dc 0 0 width height))
(send area start-plot)
(send area start-renderer x-min x-max y-min y-max z-min z-max)
(send area start-renderer bounds-rect)
(data area)
(send area end-renderers)
(send area end-plot)

6
collects/plot/plot2d/contour.rkt
View File

@ -14,7 +14,7 @@
;; One contour line
(define ((isoline-render-proc g z samples color width style alpha label) area)
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(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))
@ -58,7 +58,7 @@
(define ((contours-render-proc g levels samples colors widths styles alphas label) area)
(let/ec return
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(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))
@ -117,7 +117,7 @@
g levels samples colors styles contour-colors contour-widths contour-styles alphas label)
area)
(let/ec return
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(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))

22
collects/plot/plot2d/decoration.rkt
View File

@ -16,8 +16,7 @@
;; X and Y axes
(define ((x-axis-render-proc y ticks? labels? far? alpha) area)
(define x-min (send area get-x-min))
(define x-max (send area get-x-max))
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(define x-ticks (if far? (send area get-x-far-ticks) (send area get-x-ticks)))
(define radius (if ticks? (* 1/2 (plot-tick-size)) 0))
@ -50,8 +49,7 @@
(renderer2d #f #f #f (x-axis-render-proc y ticks? labels? far? alpha)))
(define ((y-axis-render-proc x ticks? labels? far? alpha) area)
(define y-min (send area get-y-min))
(define y-max (send area get-y-max))
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(define y-ticks (if far? (send area get-y-far-ticks) (send area get-y-ticks)))
(define radius (if ticks? (* 1/2 (plot-tick-size)) 0))
@ -113,7 +111,7 @@
(values θ r-min r-max)))
(define (draw-polar-axis-ticks num labels? area)
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define-values (θs r-mins r-maxs) (build-polar-axes num x-min x-max y-min y-max
(* 1/2 (/ (* 2 pi) num))))
(define corner-rs
@ -145,7 +143,7 @@
'center 0 #:outline? #t)))))
(define (draw-polar-axis-lines num area)
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define-values (θs r-mins r-maxs) (build-polar-axes num x-min x-max y-min y-max))
(send area put-minor-pen)
@ -170,8 +168,7 @@
;; Grid
(define ((x-tick-lines-render-proc) area)
(define y-min (send area get-y-min))
(define y-max (send area get-y-max))
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(define x-ticks (send area get-x-ticks))
(send area put-alpha 1/2)
@ -183,8 +180,7 @@
empty)
(define ((y-tick-lines-render-proc) area)
(define x-min (send area get-x-min))
(define x-max (send area get-x-max))
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(define y-ticks (send area get-y-ticks))
(send area put-alpha 1/2)
@ -208,13 +204,11 @@
;; Labeled points
(define (format-x-coordinate x area)
(define x-min (send area get-x-min))
(define x-max (send area get-x-max))
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(format "~a" (real->plot-label x (digits-for-range x-min x-max))))
(define (format-y-coordinate y area)
(define y-min (send area get-y-min))
(define y-max (send area get-y-max))
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(format "~a" (real->plot-label y (digits-for-range y-min y-max))))
(define (format-coordinate v area)

6
collects/plot/plot2d/interval.rkt
View File

@ -125,8 +125,7 @@
line2-color line2-width line2-style
alpha label)
area)
(define x-min (send area get-x-min))
(define x-max (send area get-x-max))
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(match-define (sample x1s y1s y1-min y1-max) (f1 x-min x-max samples))
(match-define (sample x2s y2s y2-min y2-max) (f2 x-min x-max samples))
(define v1s (map vector x1s y1s))
@ -172,8 +171,7 @@
line2-color line2-width line2-style
alpha label)
area)
(define y-min (send area get-y-min))
(define y-max (send area get-y-max))
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(match-define (sample y1s x1s x1-min x1-max) (f1 y-min y-max samples))
(match-define (sample y2s x2s x2-min x2-max) (f2 y-min y-max samples))
(define v1s (map vector x1s y1s))

6
collects/plot/plot2d/line.rkt
View File

@ -76,8 +76,7 @@
;; Function
(define ((function-render-proc f samples color width style alpha label) area)
(define x-min (send area get-x-min))
(define x-max (send area get-x-max))
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(match-define (sample xs ys y-min y-max) (f x-min x-max samples))
(send area put-alpha alpha)
@ -107,8 +106,7 @@
;; Inverse function
(define ((inverse-render-proc f samples color width style alpha label) area)
(define y-min (send area get-y-min))
(define y-max (send area get-y-max))
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(match-define (sample ys xs x-min x-max) (f y-min y-max samples))
(send area put-alpha alpha)

60
collects/plot/plot2d/plot-area.rkt
View File

@ -19,8 +19,7 @@
(define 2d-plot-area%
(class object%
(init-field rx-ticks rx-far-ticks ry-ticks ry-far-ticks
x-min x-max y-min y-max)
(init-field bounds-rect rx-ticks rx-far-ticks ry-ticks ry-far-ticks)
(init dc dc-x-min dc-y-min dc-x-size dc-y-size)
(super-new)
@ -36,9 +35,9 @@
(cond [(and (plot-decorations?) (plot-title)) (+ dc-y-min (* 3/2 char-height))]
[else dc-y-min]))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) bounds-rect)
(define x-size (- x-max x-min))
(define y-size (- y-max y-min))
(define x-mid (* 1/2 (+ x-min x-max)))
(define y-mid (* 1/2 (+ y-min y-max)))
@ -48,7 +47,7 @@
(define clip-y-min y-min)
(define clip-y-max y-max)
(define/public (clip-to-bounds rx-min rx-max ry-min ry-max)
(define (clip-to-bounds rx-min rx-max ry-min ry-max)
(set! clipping? #t)
(define cx-min (if rx-min (max* x-min rx-min) x-min))
(define cx-max (if rx-max (min* x-max rx-max) x-max))
@ -63,28 +62,21 @@
(set! clip-y-min cy-min)
(set! clip-y-max cy-max)))
(define/public (clip-to-none)
(set! clipping? #f))
(define (clip-to-none) (set! clipping? #f))
(define (in-bounds? v)
(or (not clipping?)
(point-in-bounds? v clip-x-min clip-x-max
clip-y-min clip-y-max)))
(or (not clipping?) (point-in-bounds? v clip-x-min clip-x-max clip-y-min clip-y-max)))
(define/public (get-x-ticks) x-ticks)
(define/public (get-x-far-ticks) x-far-ticks)
(define/public (get-y-ticks) y-ticks)
(define/public (get-y-far-ticks) y-far-ticks)
(define/public (get-x-min) x-min)
(define/public (get-x-max) x-max)
(define/public (get-y-min) y-min)
(define/public (get-y-max) y-max)
(define/public (get-bounds) (values x-min x-max y-min y-max))
(define/public (get-bounds-rect) bounds-rect)
(define/public (get-clip-bounds)
(cond [clipping? (values clip-x-min clip-x-max clip-y-min clip-y-max)]
[else (values x-min x-max y-min y-max)]))
(define/public (get-clip-rect)
(cond [clipping? (vector (ivl clip-x-min clip-x-max) (ivl clip-y-min clip-y-max))]
[else bounds-rect]))
(define identity-transforms?
(and (equal? (plot-x-transform) id-transform)
@ -102,28 +94,19 @@
(define (plot->dc* v) (view->dc (plot->view v)))
(define/public (plot->dc v) (plot->dc* v))
(define/public (plot-line->dc-angle v1 v2)
(match-define (vector dx dy) (v- (plot->dc* v1) (plot->dc* v2)))
(- (atan2 (- dy) dx)))
(define-values (view-x-size view-y-size)
(match-let ([(vector view-x-ivl view-y-ivl)
(bounding-rect (map plot->view (list (vector x-min y-min) (vector x-min y-max)
(vector x-max y-min) (vector x-max y-max))))])
(values (ivl-length view-x-ivl) (ivl-length view-y-ivl))))
(define (make-view->dc left right top bottom)
(define corners (list (vector x-min y-min) (vector x-min y-max)
(vector x-max y-min) (vector x-max y-max)))
(match-define (list (vector xs ys) ...) (map plot->view corners))
(define view-x-min (apply min xs))
(define view-x-max (apply max xs))
(define view-y-min (apply min ys))
(define view-y-max (apply max ys))
(define area-x-min (+ dc-x-min left))
(define area-x-max (- dc-x-max right))
(define area-y-min (+ dc-y-min top))
(define area-y-max (- dc-y-max bottom))
(define area-x-size (- area-x-max area-x-min))
(define area-y-size (- area-y-max area-y-min))
(define area-per-view-x (/ area-x-size (- view-x-max view-x-min)))
(define area-per-view-y (/ area-y-size (- view-y-max view-y-min)))
(define area-per-view-x (/ (- area-x-max area-x-min) view-x-size))
(define area-per-view-y (/ (- area-y-max area-y-min) view-y-size))
(λ (v)
(match-define (vector x y) v)
(vector (+ area-x-min (* (- x x-min) area-per-view-x))
@ -133,6 +116,10 @@
(define init-top-margin (- title-y-min dc-y-min))
(set! view->dc (make-view->dc 0 0 init-top-margin 0))
(define/public (plot-line->dc-angle v1 v2)
(match-define (vector dx dy) (v- (plot->dc* v2) (plot->dc* v1)))
(- (atan2 (- dy) dx)))
;; ===============================================================================================
;; Tick and label constants
@ -313,11 +300,13 @@
(append* (map (λ (params) (send/apply pd get-tick-endpoints (rest params)))
(get-all-tick-params)))))
(define-values (area-x-min right area-y-min bottom)
(define-values (left right top bottom)
(margin-fixpoint dc-x-min dc-x-max title-y-min dc-y-max 0 0 init-top-margin 0
get-param-vs/set-view->dc!))
(define area-x-min (+ dc-x-min left))
(define area-x-max (- dc-x-max right))
(define area-y-min (+ dc-y-min top))
(define area-y-max (- dc-y-max bottom))
;; ===============================================================================================
@ -366,7 +355,8 @@
(draw-axes)
(draw-ticks))
(define/public (start-renderer rx-min rx-max ry-min ry-max)
(define/public (start-renderer rend-bounds-rect)
(match-define (vector (ivl rx-min rx-max) (ivl ry-min ry-max)) rend-bounds-rect)
(send pd reset-drawing-params)
(send pd set-clipping-rect (vector (+ 1/2 (- area-x-min (plot-line-width)))
(+ 1/2 (- area-y-min (plot-line-width))))

11
collects/plot/plot2d/plot.rkt
View File

@ -47,7 +47,7 @@
(when (or (not (rect-regular? plot-bounds-rect))
(rect-zero-area? plot-bounds-rect))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) plot-bounds-rect)
(error 'plot "could not determine sensible plot bounds; determined x ∈ [~e,~e], y ∈ [~e,~e]"
(error 'plot "could not determine sensible plot bounds; got x ∈ [~a,~a], y ∈ [~a,~a]"
x-min x-max y-min y-max))
(define bounds-rect (rect-inexact->exact plot-bounds-rect))
@ -67,19 +67,14 @@
[plot-x-label x-label]
[plot-y-label y-label]
[plot-legend-anchor legend-anchor])
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) bounds-rect)
(define area (make-object 2d-plot-area%
x-ticks x-far-ticks y-ticks y-far-ticks
x-min x-max y-min y-max
dc x y width height))
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks dc x y width height))
(send area start-plot)
(define legend-entries
(flatten (for/list ([rend (in-list rs)])
(match-define (renderer2d rend-bounds-rect _bf _tf render-proc) rend)
(match-define (vector (ivl rx-min rx-max) (ivl ry-min ry-max))
(if rend-bounds-rect rend-bounds-rect (empty-rect 2)))
(send area start-renderer rx-min rx-max ry-min ry-max)
(send area start-renderer (if rend-bounds-rect rend-bounds-rect (empty-rect 2)))
(if render-proc (render-proc area) empty))))
(send area end-renderers)

10
collects/plot/plot2d/point.rkt
View File

@ -4,8 +4,7 @@
(require racket/contract racket/class racket/match racket/math racket/list
plot/utils
"../common/contract-doc.rkt"
"clip.rkt")
"../common/contract-doc.rkt")
(provide (all-defined-out))
@ -44,7 +43,7 @@
;; Vector fields
(define ((vector-field-render-fun f samples scale color line-width line-style alpha label) area)
(define-values (x-min x-max y-min y-max) (send area get-bounds))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define xs0 (linear-seq x-min x-max samples #:start? #t #:end? #t))
(define ys0 (linear-seq y-min y-max samples #:start? #t #:end? #t))
@ -106,14 +105,13 @@
;; Error bars
(define ((error-bars-render-fun xs ys hs color line-width line-style width alpha) area)
(define-values (x-min x-max y-min y-max) (send area get-clip-bounds))
(define clip-rect (send area get-clip-rect))
(define radius (* 1/2 width))
(send area put-alpha alpha)
(send area put-pen color line-width line-style)
(for ([x (in-list xs)] [y (in-list ys)] [h (in-list hs)])
(when (point-in-bounds? (vector x y) x-min x-max y-min y-max)
(when (rect-contains? clip-rect (vector x y))
(define v1 (vector x (- y h)))
(define v2 (vector x (+ y h)))
(send area put-line v1 v2)

15
collects/plot/plot3d/contour.rkt
View File

@ -13,8 +13,9 @@
;; One contour line in 3D (using marching squares)
(define ((contour3d-render-proc f z samples color width style alpha label) area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(match-define (2d-sample xs ys zss _z-min _z-max)
(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)))
(when (<= z-min z z-max)
@ -63,8 +64,9 @@
;; Contour lines in 3D (using marching squares)
(define ((contours3d-render-proc f levels samples colors widths styles alphas label) area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(match-define (2d-sample xs ys zss _z-min _z-max)
(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)))
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #f))
@ -127,8 +129,9 @@
f levels samples colors line-colors line-widths line-styles
contour-colors contour-widths contour-styles alphas label)
area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(match-define (2d-sample xs ys zss _z-min _z-max)
(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)))
(match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #t))

9
collects/plot/plot3d/isosurface.rkt
View File

@ -16,7 +16,8 @@
(define ((isosurface3d-render-proc f d samples color line-color line-width line-style alpha label)
area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(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)
@ -85,7 +86,8 @@
(define ((isosurfaces3d-render-proc
f rd-min rd-max levels samples colors line-colors line-widths line-styles alphas label)
area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(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)
@ -171,7 +173,8 @@
;; ===================================================================================================
(define ((polar3d-render-proc f g samples color line-color line-width line-style alpha label) area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(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)

109
collects/plot/plot3d/plot-area.rkt
View File

@ -19,8 +19,7 @@
(define 3d-plot-area%
(class object%
(init-field rx-ticks rx-far-ticks ry-ticks ry-far-ticks rz-ticks rz-far-ticks
x-min x-max y-min y-max z-min z-max)
(init-field bounds-rect rx-ticks rx-far-ticks ry-ticks ry-far-ticks rz-ticks rz-far-ticks)
(init dc dc-x-min dc-y-min dc-x-size dc-y-size)
(super-new)
@ -29,7 +28,17 @@
(define char-height (send pd get-char-height))
(define half-char-height (* 1/2 char-height))
(define char-baseline (send pd get-char-baseline))
(define dc-x-max (+ dc-x-min dc-x-size))
(define dc-y-max (+ dc-y-min dc-y-size))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) bounds-rect)
(define x-size (- x-max x-min))
(define y-size (- y-max y-min))
(define z-size (- z-max z-min))
(define x-mid (* 1/2 (+ x-min x-max)))
(define y-mid (* 1/2 (+ y-min y-max)))
(define z-mid (* 1/2 (+ z-min z-max)))
(define clipping? #f)
(define clip-x-min x-min)
@ -39,7 +48,7 @@
(define clip-z-min z-min)
(define clip-z-max z-max)
(define/public (clip-to-bounds rx-min rx-max ry-min ry-max rz-min rz-max)
(define (clip-to-bounds rx-min rx-max ry-min ry-max rz-min rz-max)
(set! clipping? #t)
(define cx-min (if rx-min (max* x-min rx-min) x-min))
(define cx-max (if rx-max (min* x-max rx-max) x-max))
@ -63,28 +72,23 @@
(define (clip-to-none) (set! clipping? #f))
(define (in-bounds? v)
(or (not clipping?)
(point-in-bounds? v clip-x-min clip-x-max clip-y-min clip-y-max clip-z-min clip-z-max)))
(or (not clipping?) (point-in-bounds? v clip-x-min clip-x-max
clip-y-min clip-y-max
clip-z-min clip-z-max)))
(define/public (get-x-min) x-min)
(define/public (get-x-max) x-max)
(define/public (get-y-min) y-min)
(define/public (get-y-max) y-max)
(define/public (get-z-min) z-min)
(define/public (get-z-max) z-max)
(define/public (get-bounds) (values x-min x-max y-min y-max z-min z-max))
(define/public (get-x-ticks) x-ticks)
(define/public (get-x-far-ticks) x-far-ticks)
(define/public (get-y-ticks) y-ticks)
(define/public (get-y-far-ticks) y-far-ticks)
(define/public (get-z-ticks) z-ticks)
(define/public (get-z-far-ticks) z-far-ticks)
(define/public (get-clip-bounds)
(cond [clipping? (values clip-x-min clip-x-max clip-y-min clip-y-max clip-z-min clip-z-max)]
[else (values x-min x-max y-min y-max z-min z-max)]))
(define/public (get-bounds-rect) bounds-rect)
(define x-size (- x-max x-min))
(define y-size (- y-max y-min))
(define z-size (- z-max z-min))
(define x-mid (* 1/2 (+ x-min x-max)))
(define y-mid (* 1/2 (+ y-min y-max)))
(define z-mid (* 1/2 (+ z-min z-max)))
(define/public (get-clip-rect)
(if clipping?
(vector (ivl clip-x-min clip-x-max) (ivl clip-y-min clip-y-max) (ivl clip-z-min clip-z-max))
bounds-rect))
(define angle (plot3d-angle))
(define altitude (plot3d-altitude))
@ -126,37 +130,28 @@
(define (plot->dc* v) (view->dc (plot->view v)))
(define/public (plot->dc v) (plot->dc* v))
(define dc-x-max (+ dc-x-min dc-x-size))
(define dc-y-max (+ dc-y-min dc-y-size))
(define-values (view-x-size view-y-size view-z-size)
(match-let ([(vector view-x-ivl view-y-ivl view-z-ivl)
(bounding-rect
(map plot->view (list (vector x-min y-min z-min) (vector x-min y-min z-max)
(vector x-min y-max z-min) (vector x-min y-max z-max)
(vector x-max y-min z-min) (vector x-max y-min z-max)
(vector x-max y-max z-min) (vector x-max y-max z-max))))])
(values (ivl-length view-x-ivl) (ivl-length view-y-ivl) (ivl-length view-z-ivl))))
(define (make-view->dc left right top bottom)
(define corners (list (vector x-min y-min z-min) (vector x-min y-min z-max)
(vector x-min y-max z-min) (vector x-min y-max z-max)
(vector x-max y-min z-min) (vector x-max y-min z-max)
(vector x-max y-max z-min) (vector x-max y-max z-max)))
(match-define (list (vector xs ys zs) ...) (map plot->view corners))
(define view-x-min (apply min xs))
(define view-x-max (apply max xs))
(define view-y-min (apply min ys))
(define view-y-max (apply max ys))
(define view-z-min (apply min zs))
(define view-z-max (apply max zs))
(define area-x-min (+ dc-x-min left))
(define area-x-max (- dc-x-max right))
(define area-y-min (+ dc-y-min top))
(define area-y-max (- dc-y-max bottom))
(define area-x-mid (* 1/2 (+ area-x-min area-x-max)))
(define area-x-size (- area-x-max area-x-min))
(define area-y-mid (* 1/2 (+ area-y-min area-y-max)))
(define area-y-size (- area-y-max area-y-min))
(define area-per-view-x (/ area-x-size (- view-x-max view-x-min)))
(define area-per-view-z (/ area-y-size (- view-z-max view-z-min)))
(define area-per-view-x (/ (- area-x-max area-x-min) view-x-size))
(define area-per-view-z (/ (- area-y-max area-y-min) view-z-size))
(λ (v)
(match-define (vector x y z) v)
(let ([x (* x area-per-view-x)] [z (* z area-per-view-z)])
(vector (+ area-x-mid x) (- area-y-mid z)))))
(match-define (vector x _ z) v)
(vector (+ area-x-mid (* x area-per-view-x))
(- area-y-mid (* z area-per-view-z)))))
;; Initial view->dc
(define init-top-margin (if (and (plot-decorations?) (plot-title)) (* 3/2 char-height) 0))
@ -178,6 +173,10 @@
(define (x-axis-dir) (plot-dir->dc-dir #(1 0 0)))
(define (y-axis-dir) (plot-dir->dc-dir #(0 1 0)))
(define/public (plot-line->dc-angle v1 v2)
(match-define (vector dx dy) (v- (plot->dc* v2) (plot->dc* v1)))
(- (atan2 (- dy) dx)))
;; ===============================================================================================
;; Tick and label constants
@ -510,10 +509,15 @@
(append* (map (λ (params) (send/apply pd get-tick-endpoints (rest params)))
(get-all-tick-params)))))
(define-values (area-x-min right area-y-min bottom)
(define-values (left right top bottom)
(margin-fixpoint dc-x-min dc-x-max dc-y-min dc-y-max 0 0 init-top-margin 0
get-param-vs/set-view->dc!))
(define area-x-min (+ dc-x-min left))
(define area-x-max (- dc-x-max right))
(define area-y-min (+ dc-y-min top))
(define area-y-max (- dc-y-max bottom))
;; ===============================================================================================
;; Plot decoration
@ -639,19 +643,20 @@
(draw-ticks (get-back-tick-params))
(draw-far-axes))
(define/public (start-renderer rx-min rx-max ry-min ry-max rz-min rz-max)
(define/public (start-renderer rend-bounds-rect)
(match-define (vector (ivl rx-min rx-max) (ivl ry-min ry-max) (ivl rz-min rz-max))
rend-bounds-rect)
(send pd reset-drawing-params)
(clip-to-bounds rx-min rx-max ry-min ry-max rz-min rz-max))
(define/public (end-renderers)
(draw-shapes render-list)
#;(
(clip-to-none)
(send pd reset-drawing-params)
(draw-title)
(draw-near-axes)
(draw-ticks (get-front-tick-params))
(draw-labels (get-front-label-params))))
(draw-labels (get-front-label-params)))
(define (draw-angles*)
(define angle-str (format " angle = ~a " (number->string (round angle))))
@ -682,11 +687,11 @@
(define/public (draw-angles) (draw-angles*))
(define (draw-legend* legend-entries)
(define gap (plot-line-width))
(define gap-size (+ (pen-gap) tick-radius))
(send pd draw-legend
legend-entries
(+ dc-x-min gap) (- dc-x-max gap)
(+ area-y-min gap) (- dc-y-max gap)))
(+ area-x-min gap-size) (- area-x-max gap-size)
(+ area-y-min gap-size) (- area-y-max gap-size)))
(define/public (draw-legend legend-entries) (draw-legend* legend-entries))

11
collects/plot/plot3d/plot.rkt
View File

@ -49,8 +49,8 @@
(when (or (not (rect-regular? plot-bounds-rect))
(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 "~a; determined x ∈ [~e,~e], y ∈ [~e,~e], z ∈ [~e,~e]"
"could not determine sensible plot bounds" x-min x-max y-min y-max z-min z-max))
(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))
(define bounds-rect (rect-inexact->exact plot-bounds-rect))
@ -82,17 +82,14 @@
[plot-legend-anchor legend-anchor])
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) bounds-rect)
(define area (make-object 3d-plot-area%
x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks
x-min x-max y-min y-max z-min z-max
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks
dc x y width height))
(send area start-plot)
(define legend-entries
(flatten (for/list ([rend (in-list rs)])
(match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
(match-define (vector (ivl rx-min rx-max) (ivl ry-min ry-max) (ivl rz-min rz-max))
(if rend-bounds-rect rend-bounds-rect (empty-rect 3)))
(send area start-renderer rx-min rx-max ry-min ry-max rz-min rz-max)
(send area start-renderer (if rend-bounds-rect rend-bounds-rect (empty-rect 3)))
(if render-proc (render-proc area) empty))))
(send area end-renderers)

2
collects/plot/plot3d/surface.rkt
View File

@ -11,7 +11,7 @@
(define ((surface3d-render-proc f samples color style line-color line-width line-style alpha label)
area)
(define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
(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)))

2
collects/plot/tests/subdivision-tests.rkt
View File

@ -1,6 +1,6 @@
#lang racket
(require plot plot/plot2d/area plot/plot3d/area)
(require plot plot/plot2d/plot-area plot/plot3d/plot-area)
(parameterize ([plot-x-transform log-transform]
[plot-x-ticks (log-ticks)])