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

Avoid allocations in BSP build and pens/brushes; most 3D plots are 5%-15% faster

Browse Source
This commit is contained in:
Neil Toronto 2014-04-06 01:13:07 -06:00
parent cd293eb379
commit eae9d4f9b0
2 changed files with 49 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt
View File

@ -152,15 +152,20 @@
;; the forseeable future) this is much faster than using a pen-list%, because it doesn't have to ;; 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. ;; synchronize access. It's also not thread-safe.
(define/public (set-pen color width style) (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-style (->pen-style style))
(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) (set! pen-width width)
(if (eq? style 'transparent) (match-define (list (app real->color-byte r)
(send dc set-pen transparent-pen) (app real->color-byte g)
(send dc set-pen (hash-ref! pen-hash (vector r g b width 'solid) (app real->color-byte b))
(λ () (make-pen% r g b width 'solid)))))) 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. ;; Sets the pen used to draw major ticks.
(define/public (set-major-pen [style 'solid]) (define/public (set-major-pen [style 'solid])
@ -171,17 +176,25 @@
(set-pen (plot-foreground) (* 1/2 (plot-line-width)) style)) (set-pen (plot-foreground) (* 1/2 (plot-line-width)) style))
(define brush-hash (make-hash)) (define brush-hash (make-hash))
(define transparent-brush (make-brush% 0 0 0 'transparent))
(define brush-color (->brush-color (plot-background))) (define brush-color (->brush-color (plot-background)))
(define brush-style 'solid)
;; Sets the brush. Same idea as set-pen. ;; Sets the brush. Same idea as set-pen.
(define/public (set-brush color style) (define/public (set-brush color 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)) (set! brush-color (->brush-color color))
(match-define (list (app real->color-byte r) (app real->color-byte g) (app real->color-byte b)) (match-define (list (app real->color-byte r)
(app real->color-byte g)
(app real->color-byte b))
brush-color) brush-color)
(let ([style (->brush-style style)]) (send dc set-brush (hash-ref! brush-hash (vector r g b brush-style)
(send dc set-brush (hash-ref! brush-hash (vector r g b style) (λ () (make-brush% r g b brush-style))))]))
(λ () (make-brush% r g b style))))))
;; Sets alpha. ;; Sets alpha.
(define/public (set-alpha a) (define/public (set-alpha a)

40
pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt
View File

@ -177,25 +177,31 @@
(define (bsp-lines->vertices ss) (define (bsp-lines->vertices ss)
(append (map line-start ss) (map line-end 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) (define (shapes->intervals ss i)
(for/list: ([s (in-list ss)]) (for/list: ([s (in-list ss)])
(match s (match s
[(points _ vs) [(points _ vs)
(define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) (define-values (x-min x-max) (coordinate-min-max vs i))
(cons (apply min xs) (apply max xs))] (interval x-min x-max 1)]
[(line _ v1 v2) [(line _ v1 v2)
(define x1 (flvector-ref v1 i)) (define x1 (flvector-ref v1 i))
(define x2 (flvector-ref v2 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) [(poly _data vs ls _norm)
(define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) (define-values (x-min x-max) (coordinate-min-max vs i))
(cons (apply min xs) (apply max xs))] (interval x-min x-max 1)]
[(lines _ vs) [(lines _ vs)
(define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) (define-values (x-min x-max) (coordinate-min-max vs i))
(cons (apply min xs) (apply max xs))]))) (interval x-min x-max 1)])))
(struct: interval ([min : Flonum] [max : Flonum] [weight : Natural]) #:transparent)
(: interval-list-union (-> (Listof interval) (Listof interval) (Listof interval))) (: interval-list-union (-> (Listof interval) (Listof interval) (Listof interval)))
(define (interval-list-union I1 I2) (define (interval-list-union I1 I2)
@ -237,11 +243,11 @@
(define I (interval a2 b2 (+ w1 w2))) (define I (interval a2 b2 (+ w1 w2)))
(interval-list-union (rest I1) (cons I (rest I2)))])])])) (interval-list-union (rest I1) (cons I (rest I2)))])])]))
(: interval-split (-> (Listof (Pair Flonum Flonum)) (Option Flonum))) (: interval-split (-> (Listof interval) (Option Flonum)))
(define (interval-split ps) (define (interval-split all-ivls)
(: ivls (Listof interval)) (: ivls (Listof interval))
(define ivls (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] (cond [(empty? ivls) empty]
[(empty? (rest ivls)) ivls] [(empty? (rest ivls)) ivls]
[else [else
@ -252,10 +258,10 @@
(cond [(empty? ivls) #f] (cond [(empty? ivls) #f]
[(empty? (rest ivls)) #f] [(empty? (rest ivls)) #f]
[else [else
(define total-w (length ps)) (define total-w (length all-ivls))
(define-values (best-x best-w _) (define-values (best-x best-w _)
(for/fold ([best-x : Flonum (interval-min (first ivls))] (for/fold ([best-x : Flonum (interval-min (first ivls))]
[best-w : Integer (length ps)] [best-w : Integer total-w]
[left-w : Integer 0] [left-w : Integer 0]
) ([ivl (in-list ivls)]) ) ([ivl (in-list ivls)])
(define max-w (max left-w (- total-w left-w))) (define max-w (max left-w (- total-w left-w)))
@ -272,9 +278,7 @@
(: vertices->axes (-> (Listof FlVector) (Listof axis))) (: vertices->axes (-> (Listof FlVector) (Listof axis)))
(define (vertices->axes vs) (define (vertices->axes vs)
(for/list ([i (in-list '(0 1 2))]) (for/list ([i (in-list '(0 1 2))])
(define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs)) (define-values (x-min x-max) (coordinate-min-max vs i))
(define x-min (apply min xs))
(define x-max (apply max xs))
(axis i (- x-max x-min) x-min x-max (* 0.5 (+ x-min x-max))))) (axis i (- x-max x-min) x-min x-max (* 0.5 (+ x-min x-max)))))
(: axial-plane (-> Index Flonum FlVector)) (: axial-plane (-> Index Flonum FlVector))