Speed improvements in clipping
This commit is contained in:
parent
d953a093c7
commit
a4f245b273
|
@ -151,7 +151,8 @@
|
|||
(define plot-device%
|
||||
(class object%
|
||||
(init-field dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
|
||||
|
||||
;(init-field the-dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
;(define dc (make-object null-dc%))
|
||||
|
||||
(super-new)
|
||||
|
|
|
@ -11,7 +11,7 @@
|
|||
|
||||
(define (point-in-bounds? v x-min x-max y-min y-max)
|
||||
(match-define (vector x y) v)
|
||||
(and (x . >= . x-min) (x . <= . x-max) (y . >= . y-min) (y . <= . y-max)))
|
||||
(and (<= x-min x x-max) (<= y-min y y-max)))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Rectangle clipping
|
||||
|
@ -69,13 +69,13 @@
|
|||
|
||||
(define (clip-line v1 v2 x-min x-max y-min y-max)
|
||||
(let/ec return
|
||||
; early accept: both endpoints in bounds
|
||||
(when (and (point-in-bounds? v1 x-min x-max y-min y-max)
|
||||
(point-in-bounds? v2 x-min x-max y-min y-max))
|
||||
(return v1 v2))
|
||||
; early reject: both endpoints on the outside of the same plane
|
||||
(match-define (vector x1 y1) v1)
|
||||
(match-define (vector x2 y2) v2)
|
||||
;; early accept: both endpoints in bounds
|
||||
(when (and (<= x-min x1 x-max) (<= y-min y1 y-max)
|
||||
(<= x-min x2 x-max) (<= y-min y2 y-max))
|
||||
(return v1 v2))
|
||||
;; early reject: both endpoints on the outside of the same plane
|
||||
(when (or (and (x1 . < . x-min) (x2 . < . x-min)) (and (x1 . > . x-max) (x2 . > . x-max))
|
||||
(and (y1 . < . y-min) (y2 . < . y-min)) (and (y1 . > . y-max) (y2 . > . y-max)))
|
||||
(return #f #f))
|
||||
|
@ -88,60 +88,65 @@
|
|||
;; ===================================================================================================
|
||||
;; Polygon clipping
|
||||
|
||||
(define ((make-clip-polygon idx test? clip-line) val vs)
|
||||
(reverse
|
||||
(for/fold ([res empty]) ([v1 (in-list (cons (last vs) vs))] [v2 (in-list vs)])
|
||||
(define v1-in-bounds? (test? (vector-ref v1 idx) val))
|
||||
(define v2-in-bounds? (test? (vector-ref v2 idx) val))
|
||||
(cond [(and v1-in-bounds? v2-in-bounds?) (cons v2 res)]
|
||||
[(and (not v1-in-bounds?) (not v2-in-bounds?)) res]
|
||||
[else (match-define (vector x1 y1) v1)
|
||||
(match-define (vector x2 y2) v2)
|
||||
(let-values ([(x1 y1 x2 y2) (clip-line v1-in-bounds? val x1 y1 x2 y2)])
|
||||
(cond [v2-in-bounds? (list* (vector x2 y2) (vector x1 y1) res)]
|
||||
[else (cons (vector x2 y2) res)]))]))))
|
||||
(define-syntax-rule (make-clip-polygon in-bounds? clip-line)
|
||||
(λ (val xs ys)
|
||||
(cond [(empty? xs) (values empty empty)]
|
||||
[else
|
||||
(for/fold ([res-xs empty] [res-ys empty]) ([x1 (in-list (cons (last xs) xs))]
|
||||
[x2 (in-list xs)]
|
||||
[y1 (in-list (cons (last ys) ys))]
|
||||
[y2 (in-list ys)])
|
||||
(define v1-in-bounds? (in-bounds? x1 y1 val))
|
||||
(define v2-in-bounds? (in-bounds? x2 y2 val))
|
||||
(cond [(and v1-in-bounds? v2-in-bounds?) (values (cons x2 res-xs)
|
||||
(cons y2 res-ys))]
|
||||
[(and (not v1-in-bounds?) (not v2-in-bounds?)) (values res-xs res-ys)]
|
||||
[else (let-values ([(x1 y1 x2 y2) (clip-line v1-in-bounds? val x1 y1 x2 y2)])
|
||||
(cond [v2-in-bounds? (values (list* x2 x1 res-xs)
|
||||
(list* y2 y1 res-ys))]
|
||||
[else (values (cons x2 res-xs) (cons y2 res-ys))]))]))])))
|
||||
|
||||
(define clip-polygon-x-min (make-clip-polygon 0 >= clip-line-x))
|
||||
(define clip-polygon-x-max (make-clip-polygon 0 <= clip-line-x))
|
||||
(define clip-polygon-y-min (make-clip-polygon 1 >= clip-line-y))
|
||||
(define clip-polygon-y-max (make-clip-polygon 1 <= clip-line-y))
|
||||
(define-syntax-rule (x-min-in-bounds? x y x-min) (x . >= . x-min))
|
||||
(define-syntax-rule (x-max-in-bounds? x y x-max) (x . <= . x-max))
|
||||
(define-syntax-rule (y-min-in-bounds? x y y-min) (y . >= . y-min))
|
||||
(define-syntax-rule (y-max-in-bounds? x y y-max) (y . <= . y-max))
|
||||
|
||||
(define clip-polygon-x-min (make-clip-polygon x-min-in-bounds? clip-line-x))
|
||||
(define clip-polygon-x-max (make-clip-polygon x-max-in-bounds? clip-line-x))
|
||||
(define clip-polygon-y-min (make-clip-polygon y-min-in-bounds? clip-line-y))
|
||||
(define clip-polygon-y-max (make-clip-polygon y-max-in-bounds? clip-line-y))
|
||||
|
||||
(define (clip-polygon vs x-min x-max y-min y-max)
|
||||
(let/ec return
|
||||
; early reject: no polygon
|
||||
;; early reject: no polygon
|
||||
(when (empty? vs) (return empty))
|
||||
; early accept: all endpoints in bounds
|
||||
(when (andmap (λ (v) (point-in-bounds? v x-min x-max y-min y-max)) vs)
|
||||
(return vs))
|
||||
(match-define (list (vector xs ys) ...) vs)
|
||||
; early reject: all endpoints on the outside of the same plane
|
||||
;; early accept: all endpoints in bounds
|
||||
(when (and (andmap (λ (x) (<= x-min x x-max)) xs)
|
||||
(andmap (λ (y) (<= y-min y y-max)) ys))
|
||||
(return vs))
|
||||
;; early reject: all endpoints on the outside of the same plane
|
||||
(when (or (andmap (λ (x) (x . < . x-min)) xs) (andmap (λ (x) (x . > . x-max)) xs)
|
||||
(andmap (λ (y) (y . < . y-min)) ys) (andmap (λ (y) (y . > . y-max)) ys))
|
||||
(return empty))
|
||||
(let* ([vs (clip-polygon-x-min x-min vs)]
|
||||
[_ (when (empty? vs) (return empty))]
|
||||
[vs (clip-polygon-x-max x-max vs)]
|
||||
[_ (when (empty? vs) (return empty))]
|
||||
[vs (clip-polygon-y-min y-min vs)]
|
||||
[_ (when (empty? vs) (return empty))]
|
||||
[vs (clip-polygon-y-max y-max vs)])
|
||||
vs)))
|
||||
(let*-values ([(xs ys) (clip-polygon-x-min x-min xs ys)]
|
||||
[(xs ys) (clip-polygon-x-max x-max xs ys)]
|
||||
[(xs ys) (clip-polygon-y-min y-min xs ys)]
|
||||
[(xs ys) (clip-polygon-y-max y-max xs ys)])
|
||||
(map vector xs ys))))
|
||||
|
||||
;; =============================================================================
|
||||
;; ===================================================================================================
|
||||
;; Lines clipping
|
||||
|
||||
;; This could be done a lot faster...
|
||||
|
||||
(define (join-lines lines [current-line empty])
|
||||
(cond [(empty? lines) (list (reverse current-line))]
|
||||
[(empty? current-line) (join-lines (rest lines)
|
||||
(reverse (first lines)))]
|
||||
[else
|
||||
(match-define v (first current-line))
|
||||
(match-define (list v1 v2) (first lines))
|
||||
(cond [(equal? v v1) (join-lines (rest lines) (cons v2 current-line))]
|
||||
[else (cons (reverse current-line)
|
||||
(join-lines lines empty))])]))
|
||||
(define (join-lines lines)
|
||||
(let loop ([lines lines] [current-line empty])
|
||||
(cond [(empty? lines) (list (reverse current-line))]
|
||||
[(empty? current-line) (loop (rest lines) (reverse (first lines)))]
|
||||
[else
|
||||
(match-define v (first current-line))
|
||||
(match-define (list v1 v2) (first lines))
|
||||
(cond [(equal? v v1) (loop (rest lines) (cons v2 current-line))]
|
||||
[else (cons (reverse current-line) (loop lines empty))])])))
|
||||
|
||||
#;
|
||||
(join-lines
|
||||
|
@ -151,12 +156,20 @@
|
|||
(#(7 8) #(9 10))))
|
||||
|
||||
(define (clip-lines vs x-min x-max y-min y-max)
|
||||
(if (empty? vs)
|
||||
empty
|
||||
(join-lines
|
||||
(reverse
|
||||
(for/fold ([res empty]) ([v1 (in-list vs)] [v2 (in-list (rest vs))])
|
||||
(let-values ([(v1 v2) (clip-line v1 v2 x-min x-max y-min y-max)])
|
||||
(if (and v1 v2)
|
||||
(cons (list v1 v2) res)
|
||||
res)))))))
|
||||
(let/ec return
|
||||
;; early reject: no lines
|
||||
(when (empty? vs) (return empty))
|
||||
(match-define (list (vector xs ys) ...) vs)
|
||||
;; early accept: all endpoints in bounds
|
||||
(when (and (andmap (λ (x) (<= x-min x x-max)) xs) (andmap (λ (y) (<= y-min y y-max)) ys))
|
||||
(return (list vs)))
|
||||
;; early reject: all endpoints on the outside of the same plane
|
||||
(when (or (andmap (λ (x) (x . < . x-min)) xs) (andmap (λ (x) (x . > . x-max)) xs)
|
||||
(andmap (λ (y) (y . < . y-min)) ys) (andmap (λ (y) (y . > . y-max)) ys))
|
||||
(return empty))
|
||||
(join-lines
|
||||
(reverse
|
||||
(for/fold ([res empty]) ([v1 (in-list vs)] [v2 (in-list (rest vs))])
|
||||
(let-values ([(v1 v2) (clip-line v1 v2 x-min x-max y-min y-max)])
|
||||
(cond [(and v1 v2) (cons (list v1 v2) res)]
|
||||
[else res])))))))
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
;; Small library for clipping points, lines and polygons against axial planes.
|
||||
|
||||
(require racket/match racket/list)
|
||||
(require racket/match racket/list racket/unsafe/ops)
|
||||
|
||||
(provide point-in-bounds? clip-line clip-polygon)
|
||||
|
||||
|
@ -11,9 +11,7 @@
|
|||
|
||||
(define (point-in-bounds? v x-min x-max y-min y-max z-min z-max)
|
||||
(match-define (vector x y z) v)
|
||||
(and (x . >= . x-min) (x . <= . x-max)
|
||||
(y . >= . y-min) (y . <= . y-max)
|
||||
(z . >= . z-min) (z . <= . z-max)))
|
||||
(and (<= x-min x x-max) (<= y-min y y-max) (<= z-min z z-max)))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Lines
|
||||
|
@ -65,13 +63,13 @@
|
|||
|
||||
(define (clip-line v1 v2 x-min x-max y-min y-max z-min z-max)
|
||||
(let/ec return
|
||||
; early accept: both endpoints in bounds
|
||||
(when (and (point-in-bounds? v1 x-min x-max y-min y-max z-min z-max)
|
||||
(point-in-bounds? v2 x-min x-max y-min y-max z-min z-max))
|
||||
(return v1 v2))
|
||||
; early reject: both endpoints on the outside of the same plane
|
||||
(match-define (vector x1 y1 z1) v1)
|
||||
(match-define (vector x2 y2 z2) v2)
|
||||
;; early accept: both endpoints in bounds
|
||||
(when (and (<= x-min x1 x-max) (<= y-min y1 y-max) (<= z-min z1 z-max)
|
||||
(<= x-min x2 x-max) (<= y-min y2 y-max) (<= z-min z2 z-max))
|
||||
(return v1 v2))
|
||||
;; early reject: both endpoints on the outside of the same plane
|
||||
(when (or (and (x1 . < . x-min) (x2 . < . x-min)) (and (x1 . > . x-max) (x2 . > . x-max))
|
||||
(and (y1 . < . y-min) (y2 . < . y-min)) (and (y1 . > . y-max) (y2 . > . y-max))
|
||||
(and (z1 . < . z-min) (z2 . < . z-min)) (and (z1 . > . z-max) (z2 . > . z-max)))
|
||||
|
@ -87,13 +85,13 @@
|
|||
;; ===================================================================================================
|
||||
;; Polygons
|
||||
|
||||
(define ((make-clip-polygon idx test? clip-line) val vs)
|
||||
(reverse
|
||||
(for/fold ([res empty]) ([v1 (in-list (cons (last vs) vs))] [v2 (in-list vs)])
|
||||
(define v1-in-bounds? (test? (vector-ref v1 idx) val))
|
||||
(define v2-in-bounds? (test? (vector-ref v2 idx) val))
|
||||
(cond [(and v1-in-bounds? v2-in-bounds?) (cons v2 res)]
|
||||
[(and (not v1-in-bounds?) (not v2-in-bounds?)) res]
|
||||
(define-syntax-rule (make-clip-polygon idx test? clip-line)
|
||||
(λ (val vs)
|
||||
(for/fold ([res empty]) ([v1 (in-list (cons (last vs) vs))] [v2 (in-list vs)])
|
||||
(define v1-in-bounds? (test? (unsafe-vector-ref v1 idx) val))
|
||||
(define v2-in-bounds? (test? (unsafe-vector-ref v2 idx) val))
|
||||
(cond [(and v1-in-bounds? v2-in-bounds?) (cons v2 res)]
|
||||
[(and (not v1-in-bounds?) (not v2-in-bounds?)) res]
|
||||
[else (match-define (vector x1 y1 z1) v1)
|
||||
(match-define (vector x2 y2 z2) v2)
|
||||
(let-values ([(x1 y1 z1 x2 y2 z2) (clip-line v1-in-bounds? val x1 y1 z1 x2 y2 z2)])
|
||||
|
@ -109,13 +107,15 @@
|
|||
|
||||
(define (clip-polygon vs x-min x-max y-min y-max z-min z-max)
|
||||
(let/ec return
|
||||
; early reject: no polygon
|
||||
;; early reject: no polygon
|
||||
(when (empty? vs) (return empty))
|
||||
; early accept: all endpoints in bounds
|
||||
(when (andmap (λ (v) (point-in-bounds? v x-min x-max y-min y-max z-min z-max)) vs)
|
||||
(return vs))
|
||||
(match-define (list (vector xs ys zs) ...) vs)
|
||||
; early reject: all endpoints on the outside of the same plane
|
||||
;; early accept: all endpoints in bounds
|
||||
(when (and (andmap (λ (x) (<= x-min x x-max)) xs)
|
||||
(andmap (λ (y) (<= y-min y y-max)) ys)
|
||||
(andmap (λ (z) (<= z-min z z-max)) zs))
|
||||
(return vs))
|
||||
;; early reject: all endpoints on the outside of the same plane
|
||||
(when (or (andmap (λ (x) (x . < . x-min)) xs) (andmap (λ (x) (x . > . x-max)) xs)
|
||||
(andmap (λ (y) (y . < . y-min)) ys) (andmap (λ (y) (y . > . y-max)) ys)
|
||||
(andmap (λ (z) (z . < . z-min)) zs) (andmap (λ (z) (z . > . z-max)) zs))
|
||||
|
|
|
@ -645,12 +645,13 @@
|
|||
|
||||
(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))))
|
||||
|
|
|
@ -9,24 +9,11 @@
|
|||
@itemlist[
|
||||
@item{2D kernel density estimator}
|
||||
@item{3D kernel density estimator}
|
||||
@item{2D implicit curve}
|
||||
@item{3D implicit surface}
|
||||
@item{3D decorations: labeled points, axes, grids}
|
||||
]
|
||||
}
|
||||
@item{Possible new renderers
|
||||
@itemlist[
|
||||
@item{R × R -> R parametric (turn into 3D implicit surface by solving for minimum distance?)}
|
||||
@item{3D vector field}
|
||||
@item{Head-to-tail vector fields}
|
||||
]
|
||||
}
|
||||
@item{Minor fixes
|
||||
@itemlist[
|
||||
@item{Subdivide nonlinearly transformed 3D lines/polygons (port from @(racket 2d-plot-area%))}
|
||||
]
|
||||
}
|
||||
@item{Minor enhancements
|
||||
@item{Possible minor enhancements
|
||||
@itemlist[
|
||||
@item{Better depth sorting (possibly split intersecting polygons; look into BSP tree)}
|
||||
@item{Legend entries have minimum sizes}
|
||||
|
|
Loading…
Reference in New Issue
Block a user