From 6bed60452a377cd34e80684f25219129098ebd6a Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Fri, 4 Nov 2011 02:49:58 -0600 Subject: [PATCH] Began finalizing public interface to *d-plot-area% classes --- collects/plot/common/math.rkt | 12 +-- collects/plot/compat.rkt | 18 ++-- collects/plot/plot2d/contour.rkt | 6 +- collects/plot/plot2d/decoration.rkt | 22 ++--- collects/plot/plot2d/interval.rkt | 6 +- collects/plot/plot2d/line.rkt | 6 +- collects/plot/plot2d/plot-area.rkt | 60 +++++------- collects/plot/plot2d/plot.rkt | 11 +-- collects/plot/plot2d/point.rkt | 10 +- collects/plot/plot3d/contour.rkt | 15 +-- collects/plot/plot3d/isosurface.rkt | 9 +- collects/plot/plot3d/plot-area.rkt | 109 +++++++++++----------- collects/plot/plot3d/plot.rkt | 11 +-- collects/plot/plot3d/surface.rkt | 2 +- collects/plot/tests/subdivision-tests.rkt | 2 +- 15 files changed, 135 insertions(+), 164 deletions(-) diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt index 33930a31d8..f45ee894f3 100644 --- a/collects/plot/common/math.rkt +++ b/collects/plot/common/math.rkt @@ -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 diff --git a/collects/plot/compat.rkt b/collects/plot/compat.rkt index 4ebe795818..21a4a98af8 100644 --- a/collects/plot/compat.rkt +++ b/collects/plot/compat.rkt @@ -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) diff --git a/collects/plot/plot2d/contour.rkt b/collects/plot/plot2d/contour.rkt index df666126a5..50a4479447 100644 --- a/collects/plot/plot2d/contour.rkt +++ b/collects/plot/plot2d/contour.rkt @@ -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)) diff --git a/collects/plot/plot2d/decoration.rkt b/collects/plot/plot2d/decoration.rkt index c094c462eb..657ed6e587 100644 --- a/collects/plot/plot2d/decoration.rkt +++ b/collects/plot/plot2d/decoration.rkt @@ -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) diff --git a/collects/plot/plot2d/interval.rkt b/collects/plot/plot2d/interval.rkt index 6d9d4f0a64..ddf249ba1e 100644 --- a/collects/plot/plot2d/interval.rkt +++ b/collects/plot/plot2d/interval.rkt @@ -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)) diff --git a/collects/plot/plot2d/line.rkt b/collects/plot/plot2d/line.rkt index 0e4b02ad0c..ff4560ce58 100644 --- a/collects/plot/plot2d/line.rkt +++ b/collects/plot/plot2d/line.rkt @@ -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) diff --git a/collects/plot/plot2d/plot-area.rkt b/collects/plot/plot2d/plot-area.rkt index 580b121917..92b1262577 100644 --- a/collects/plot/plot2d/plot-area.rkt +++ b/collects/plot/plot2d/plot-area.rkt @@ -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)))) diff --git a/collects/plot/plot2d/plot.rkt b/collects/plot/plot2d/plot.rkt index fe94bdda0c..8eab65d4a2 100644 --- a/collects/plot/plot2d/plot.rkt +++ b/collects/plot/plot2d/plot.rkt @@ -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) diff --git a/collects/plot/plot2d/point.rkt b/collects/plot/plot2d/point.rkt index 243d0247cd..6623dfa81c 100644 --- a/collects/plot/plot2d/point.rkt +++ b/collects/plot/plot2d/point.rkt @@ -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) diff --git a/collects/plot/plot3d/contour.rkt b/collects/plot/plot3d/contour.rkt index 7a089730be..2adb0f8e3a 100644 --- a/collects/plot/plot3d/contour.rkt +++ b/collects/plot/plot3d/contour.rkt @@ -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)) diff --git a/collects/plot/plot3d/isosurface.rkt b/collects/plot/plot3d/isosurface.rkt index e43e49ae40..be65ac5059 100644 --- a/collects/plot/plot3d/isosurface.rkt +++ b/collects/plot/plot3d/isosurface.rkt @@ -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) diff --git a/collects/plot/plot3d/plot-area.rkt b/collects/plot/plot3d/plot-area.rkt index 93774d474d..ccf0eca391 100644 --- a/collects/plot/plot3d/plot-area.rkt +++ b/collects/plot/plot3d/plot-area.rkt @@ -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)) diff --git a/collects/plot/plot3d/plot.rkt b/collects/plot/plot3d/plot.rkt index a57b1bfee0..870ca26315 100644 --- a/collects/plot/plot3d/plot.rkt +++ b/collects/plot/plot3d/plot.rkt @@ -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) diff --git a/collects/plot/plot3d/surface.rkt b/collects/plot/plot3d/surface.rkt index 928b8dcf3d..5ff83e1ea4 100644 --- a/collects/plot/plot3d/surface.rkt +++ b/collects/plot/plot3d/surface.rkt @@ -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))) diff --git a/collects/plot/tests/subdivision-tests.rkt b/collects/plot/tests/subdivision-tests.rkt index 5f5482c2b5..bdaf8cffcf 100644 --- a/collects/plot/tests/subdivision-tests.rkt +++ b/collects/plot/tests/subdivision-tests.rkt @@ -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)])