shivers@cs.cmu.edu (Olin Shivers) (02/13/90)
Here's an implementation I wrote in T in 1983. It's a fairly simple
little algorithm. For clarity, I removed all the floating point
declarations that made it go fast. This code uses a fair amount of macro
support for my Scheme ideolect: I use the UCI Lisp FOR macro, ? is CONS,
and so forth. But it should be reasonably clear.
My bogus mailer fired this message off earlier in mid-post. Please ignore
the earlier message.
-Olin
===============================================================================
(herald planeint (env t (graphics points) (tlib hacks) (tutil for)))
;(require hacks (tlib hacks))
;(require points (graphics points))
;;; This file contains functions for doing operations on points and
;;; planes.
;;; plane-sign tells which side of a plane the point is on. It is negative
;;; if the pt is on the negative side, 0 if it is in the plane, and positive
;;; if the pt is on the positive side.
(define-integrable (plane-sign plane pt)
(+ (plane:d plane) (dot-prod plane pt)))
;;; crosses-plane? returns true <==> pt0 and pt1 are on opposite sides of
;;; the plane. (minus? (* (plane-sign plane pt0) (plane-sign plane pt1)))
(define (crosses-plane? plane pt0 pt1)
(> 0.0 (* (plane-sign plane pt0) (plane-sign plane pt1))))
;;; plane-intersect gives the point which is the intersection of plane and
;;; the line running through pt0 and pt1. If the plane is (P; d) and
;;; the points are A and B, the intersection parameter s is
;;; P.A - d
;;; s = -------
;;; P.(A-B)
(define (plane-intersect plane pt0 pt1)
(let ((delta (pt- pt1 pt0)))
(if (pt-zero? delta)
(error "plane-intersect: degenerate line segment (~s,~s)~%" pt0 pt1)
(let ((denom (- 0.0 (dot-prod plane delta))))
(if (= 0.0 denom)
(error "plane-intersect: line (~s,~s) is parallel to plane ~s~%"
pt0 pt1 plane)
(let ((s (/ (- (dot-prod plane pt0) (plane:d plane)) denom)))
(pt+ pt0 (pt* delta s))))))))
;;; gen-polygon-clipper takes a plane and a continuation as args. It
;;; returns a closure that, when called on successive points in a polygon,
;;; clips them against the plane and sends them on to the continuation.
;;; The polygon is terminated by calling the clipper on T or NIL. If
;;; the closure is called on T, the polygon is closed, i.e. the previous
;;; point is connected to the first point of the polygon. Note that the
;;; T/NIL value is passed along also, in case the continuation is another
;;; splitting or clipping stage.
(define (gen-polygon-clipper plane cont)
(let ((first-pt nil) (pt0 nil))
(lambda (x)
(? ((eq? x t) ;x=t means time to close the polygon
(if (and first-pt (crosses-plane? plane pt0 first-pt))
(cont (plane-intersect plane pt0 first-pt)))
(set first-pt nil)
(cont t)) ;pass along the close signal
(x ;x is the next point in the polygon
(if (not first-pt) (set first-pt x)
(if (crosses-plane? plane pt0 x) ;edge crosses ==>
(cont (plane-intersect plane x pt0)))) ;output intersection
(set pt0 x)
(if (<= 0.0 (plane-sign plane pt0)) (cont pt0)))
(t ;null x means the stream is done, but do not close back to first-pt
(set first-pt nil)
(cont nil) ;pass along the close signal
)))))
(define (gen-polygon-splitter plane cont1 cont2)
(let ((first-pt nil) (pt0 nil))
(lambda (x)
(? ((eq? x t) ;x=t means time to close the split polys
(if (crosses-plane? plane pt0 first-pt)
(let ((i (plane-intersect plane pt0 first)))
(cont1 i)
(cont2 i)))
(set first-pt nil)
(cont1 t) ;pass along the close signal
(cont2 t))
(x
(if (null? first-pt) (set first-pt x)
(if (crosses-plane? plane pt0 x)
(let ((i (plane-intersect plane pt0 x)))
(cont1 i)
(cont2 i))))
(set pt0 x)
(let ((s (plane-sign plane pt0)))
(if (<= 0.0 s) (cont1 pt0))
(if (>= 0.0 s) (cont2 pt0))))
(t ;null x means the stream is done, but do not close back to first-pt
(set first-pt nil)
(cont1 nil) ;pass along the done signal
(cont2 nil)
)))))
(define (clip-polygon polygon plane)
(let ((pts (disclose-pts polygon))
(newpts nil))
(let ((clipper (gen-polygon-clipper plane (lambda (x) (push newpts x)))))
;;feed the points to the polygon clipper
(for (x in pts)
(do (clipper x)))
;;close the polygon
(clipper t)
;;return the polygon whose points are newpts
(polygon:new (reverse! (cdr newpts))))))sean@ms.uky.edu (Sean Casey) (02/13/90)
shivers@cs.cmu.edu (Olin Shivers) writes: |Here's an implementation I wrote in T in 1983. It's a fairly simple |little algorithm. I'm really bad at counting parenthesis :-). Wanna tell me what that would look like in pascal or C? Sean -- *** Sean Casey sean@ms.uky.edu, sean@ukma.bitnet, ukma!sean *** "May I take this opportunity of emphasizing that there is no cannibalism *** in the British Navy. Absolutely none, and when I say none, I mean there *** is a certain amount, more than we are prepared to admit." -MP