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

Clipping lines now uses exact arithmetic. Fixes visual issues with plotting inexact functions at very small scales. Every plot should render correctly at every scale now.

Browse Source
This commit is contained in:
Neil Toronto 2012-01-27 10:39:39 -07:00
parent e4b1ef1b6e
commit 713772959f
2 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/plot/plot2d/clip.rkt
View File

@ -2,7 +2,8 @@
;; Small library for clipping points, rectangles, lines and polygons against axial planes.
(require racket/match racket/list)
(require racket/match racket/list
"../common/utils.rkt")
(provide point-in-bounds? clip-line clip-lines clip-polygon)
@ -17,14 +18,18 @@
;; Line clipping
(define (clip-line-x start-in-bounds? x x1 y1 x2 y2)
(define t (/ (- x x1) (- x2 x1)))
(cond [start-in-bounds? (values x1 y1 x (+ y1 (* t (- y2 y1))))]
[else (values x (+ y1 (* t (- y2 y1))) x2 y2)]))
(let-map
(x x1 y1 x2 y2) inexact->exact
(define t (/ (- x x1) (- x2 x1)))
(cond [start-in-bounds? (values x1 y1 x (+ y1 (* t (- y2 y1))))]
[else (values x (+ y1 (* t (- y2 y1))) x2 y2)])))
(define (clip-line-y start-in-bounds? y x1 y1 x2 y2)
(define t (/ (- y y1) (- y2 y1)))
(cond [start-in-bounds? (values x1 y1 (+ x1 (* t (- x2 x1))) y)]
[else (values (+ x1 (* t (- x2 x1))) y x2 y2)]))
(let-map
(y x1 y1 x2 y2) inexact->exact
(define t (/ (- y y1) (- y2 y1)))
(cond [start-in-bounds? (values x1 y1 (+ x1 (* t (- x2 x1))) y)]
[else (values (+ x1 (* t (- x2 x1))) y x2 y2)])))
(define (clip-line-x-min x-min x1 y1 x2 y2)
(cond [(and (x1 . >= . x-min) (x2 . < . x-min)) (clip-line-x #t x-min x1 y1 x2 y2)]

27
collects/plot/plot3d/clip.rkt
View File

@ -2,7 +2,8 @@
;; Small library for clipping points, lines and polygons against axial planes.
(require racket/match racket/list racket/unsafe/ops)
(require racket/match racket/list racket/unsafe/ops
"../common/utils.rkt")
(provide point-in-bounds? clip-line clip-polygon
clip-polygon-x-min clip-polygon-x-max
@ -20,19 +21,25 @@
;; Lines
(define (clip-line-x start-in-bounds? x x1 y1 z1 x2 y2 z2)
(define t (/ (- x x1) (- x2 x1)))
(cond [start-in-bounds? (values x1 y1 z1 x (+ y1 (* t (- y2 y1))) (+ z1 (* t (- z2 z1))))]
[else (values x (+ y1 (* t (- y2 y1))) (+ z1 (* t (- z2 z1))) x2 y2 z2)]))
(let-map
(x x1 y1 z1 x2 y2 z2) inexact->exact
(define t (/ (- x x1) (- x2 x1)))
(cond [start-in-bounds? (values x1 y1 z1 x (+ y1 (* t (- y2 y1))) (+ z1 (* t (- z2 z1))))]
[else (values x (+ y1 (* t (- y2 y1))) (+ z1 (* t (- z2 z1))) x2 y2 z2)])))
(define (clip-line-y start-in-bounds? y x1 y1 z1 x2 y2 z2)
(define t (/ (- y y1) (- y2 y1)))
(cond [start-in-bounds? (values x1 y1 z1 (+ x1 (* t (- x2 x1))) y (+ z1 (* t (- z2 z1))))]
[else (values (+ x1 (* t (- x2 x1))) y (+ z1 (* t (- z2 z1))) x2 y2 z2)]))
(let-map
(y x1 y1 z1 x2 y2 z2) inexact->exact
(define t (/ (- y y1) (- y2 y1)))
(cond [start-in-bounds? (values x1 y1 z1 (+ x1 (* t (- x2 x1))) y (+ z1 (* t (- z2 z1))))]
[else (values (+ x1 (* t (- x2 x1))) y (+ z1 (* t (- z2 z1))) x2 y2 z2)])))
(define (clip-line-z start-in-bounds? z x1 y1 z1 x2 y2 z2)
(define t (/ (- z z1) (- z2 z1)))
(cond [start-in-bounds? (values x1 y1 z1 (+ x1 (* t (- x2 x1))) (+ y1 (* t (- y2 y1))) z)]
[else (values (+ x1 (* t (- x2 x1))) (+ y1 (* t (- y2 y1))) z x2 y2 z2)]))
(let-map
(z x1 y1 z1 x2 y2 z2) inexact->exact
(define t (/ (- z z1) (- z2 z1)))
(cond [start-in-bounds? (values x1 y1 z1 (+ x1 (* t (- x2 x1))) (+ y1 (* t (- y2 y1))) z)]
[else (values (+ x1 (* t (- x2 x1))) (+ y1 (* t (- y2 y1))) z x2 y2 z2)])))
(define (clip-line-x-min x-min x1 y1 z1 x2 y2 z2)
(cond [(and (x1 . >= . x-min) (x2 . < . x-min)) (clip-line-x #t x-min x1 y1 z1 x2 y2 z2)]