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

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

View File

@ -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))
(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)
(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))))))
(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-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))
(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))))))
(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)

View File

@ -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))