diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt index 484e952762..543082c243 100644 --- a/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt +++ b/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt @@ -152,15 +152,20 @@ ;; the forseeable future) this is much faster than using a pen-list%, because it doesn't have to ;; synchronize access. It's also not thread-safe. (define/public (set-pen color width style) - (set! pen-color (->pen-color color)) - (match-define (list (app real->color-byte r) (app real->color-byte g) (app real->color-byte b)) - pen-color) (set! pen-style (->pen-style style)) - (set! pen-width width) - (if (eq? style 'transparent) - (send dc set-pen transparent-pen) - (send dc set-pen (hash-ref! pen-hash (vector r g b width 'solid) - (λ () (make-pen% r g b width 'solid)))))) + (cond [(eq? pen-style 'transparent) + (set! pen-color '(0 0 0)) + (set! pen-width 1) + (send dc set-pen transparent-pen)] + [else + (set! pen-color (->pen-color color)) + (set! pen-width width) + (match-define (list (app real->color-byte r) + (app real->color-byte g) + (app real->color-byte b)) + pen-color) + (send dc set-pen (hash-ref! pen-hash (vector r g b width) + (λ () (make-pen% r g b width 'solid))))])) ;; Sets the pen used to draw major ticks. (define/public (set-major-pen [style 'solid]) @@ -171,17 +176,25 @@ (set-pen (plot-foreground) (* 1/2 (plot-line-width)) style)) (define brush-hash (make-hash)) + (define transparent-brush (make-brush% 0 0 0 'transparent)) (define brush-color (->brush-color (plot-background))) + (define brush-style 'solid) ;; Sets the brush. Same idea as set-pen. (define/public (set-brush color style) - (set! brush-color (->brush-color color)) - (match-define (list (app real->color-byte r) (app real->color-byte g) (app real->color-byte b)) - brush-color) - (let ([style (->brush-style style)]) - (send dc set-brush (hash-ref! brush-hash (vector r g b style) - (λ () (make-brush% r g b style)))))) + (set! brush-style (->brush-style style)) + (cond [(eq? brush-style 'transparent) + (set! brush-color '(0 0 0)) + (send dc set-brush transparent-brush)] + [else + (set! brush-color (->brush-color color)) + (match-define (list (app real->color-byte r) + (app real->color-byte g) + (app real->color-byte b)) + brush-color) + (send dc set-brush (hash-ref! brush-hash (vector r g b brush-style) + (λ () (make-brush% r g b brush-style))))])) ;; Sets alpha. (define/public (set-alpha a) diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt index ff136c1e0f..b56a99a9f3 100644 --- a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt +++ b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt @@ -177,25 +177,31 @@ (define (bsp-lines->vertices ss) (append (map line-start ss) (map line-end ss))) -(: shapes->intervals (-> (Listof BSP-Shape) Index (Listof (Pair Flonum Flonum)))) +(: coordinate-min-max (-> (Listof FlVector) Index (Values Flonum Flonum))) +(define (coordinate-min-max vs i) + (for/fold ([x-min : Flonum +inf.0] [x-max : Flonum -inf.0]) ([v (in-list vs)]) + (define x (flvector-ref v i)) + (values (min x x-min) (max x x-max)))) + +(struct: interval ([min : Flonum] [max : Flonum] [weight : Natural]) #:transparent) + +(: shapes->intervals (-> (Listof BSP-Shape) Index (Listof interval))) (define (shapes->intervals ss i) (for/list: ([s (in-list ss)]) (match s [(points _ vs) - (define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) - (cons (apply min xs) (apply max xs))] + (define-values (x-min x-max) (coordinate-min-max vs i)) + (interval x-min x-max 1)] [(line _ v1 v2) (define x1 (flvector-ref v1 i)) (define x2 (flvector-ref v2 i)) - (cons (min x1 x2) (max x1 x2))] + (interval (min x1 x2) (max x1 x2) 1)] [(poly _data vs ls _norm) - (define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) - (cons (apply min xs) (apply max xs))] + (define-values (x-min x-max) (coordinate-min-max vs i)) + (interval x-min x-max 1)] [(lines _ vs) - (define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) - (cons (apply min xs) (apply max xs))]))) - -(struct: interval ([min : Flonum] [max : Flonum] [weight : Natural]) #:transparent) + (define-values (x-min x-max) (coordinate-min-max vs i)) + (interval x-min x-max 1)]))) (: interval-list-union (-> (Listof interval) (Listof interval) (Listof interval))) (define (interval-list-union I1 I2) @@ -237,11 +243,11 @@ (define I (interval a2 b2 (+ w1 w2))) (interval-list-union (rest I1) (cons I (rest I2)))])])])) -(: interval-split (-> (Listof (Pair Flonum Flonum)) (Option Flonum))) -(define (interval-split ps) +(: interval-split (-> (Listof interval) (Option Flonum))) +(define (interval-split all-ivls) (: ivls (Listof interval)) (define ivls - (let loop ([ivls (map (λ ([p : (Pair Flonum Flonum)]) (interval (car p) (cdr p) 1)) ps)]) + (let loop ([ivls all-ivls]) (cond [(empty? ivls) empty] [(empty? (rest ivls)) ivls] [else @@ -252,10 +258,10 @@ (cond [(empty? ivls) #f] [(empty? (rest ivls)) #f] [else - (define total-w (length ps)) + (define total-w (length all-ivls)) (define-values (best-x best-w _) (for/fold ([best-x : Flonum (interval-min (first ivls))] - [best-w : Integer (length ps)] + [best-w : Integer total-w] [left-w : Integer 0] ) ([ivl (in-list ivls)]) (define max-w (max left-w (- total-w left-w))) @@ -272,9 +278,7 @@ (: vertices->axes (-> (Listof FlVector) (Listof axis))) (define (vertices->axes vs) (for/list ([i (in-list '(0 1 2))]) - (define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) - (define x-min (apply min xs)) - (define x-max (apply max xs)) + (define-values (x-min x-max) (coordinate-min-max vs i)) (axis i (- x-max x-min) x-min x-max (* 0.5 (+ x-min x-max))))) (: axial-plane (-> Index Flonum FlVector))