Skip to content

Commit

Permalink
Much simpler 'compute-incident-edge'
Browse files Browse the repository at this point in the history
  • Loading branch information
dharmatech committed Jan 17, 2010
1 parent b163918 commit bf870ef
Show file tree
Hide file tree
Showing 2 changed files with 37 additions and 121 deletions.
54 changes: 17 additions & 37 deletions collide.sls
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -113,25 +113,19 @@
(set! normal (v*n rot-b.col-2 (set! normal (v*n rot-b.col-2
(if (> db.y 0.0) 1 -1))))) (if (> db.y 0.0) 1 -1)))))


(let ((front-normal #f) (let ((front-normal #f)
(side-normal #f) (side-normal #f)

(incident-edge #f)
(incident-edge (vector (create-clip-vertex) (front #f)
(create-clip-vertex))) (neg-side #f)

(pos-side #f)
(front #f) (neg-edge #f)
(neg-side #f) (pos-edge #f)
(pos-side #f) (side #f))
(neg-edge #f)
(pos-edge #f)
(side #f))


(case axis (case axis


((FACE-A-X) ((FACE-A-X)

;; (display "case FACE-A-X ")

(set! front-normal normal) (set! front-normal normal)
(set! front (+ (vec-dot pos-a front-normal) ha.x)) (set! front (+ (vec-dot pos-a front-normal) ha.x))
(set! side-normal rot-a.col-2) (set! side-normal rot-a.col-2)
Expand All @@ -140,16 +134,10 @@
(set! pos-side (+ side ha.y)) (set! pos-side (+ side ha.y))
(set! neg-edge EDGE3) (set! neg-edge EDGE3)
(set! pos-edge EDGE1) (set! pos-edge EDGE1)

(set! incident-edge
(compute-incident-edge (compute-incident-edge hb pos-b rot-b front-normal)))
incident-edge hb pos-b rot-b front-normal)

)


((FACE-A-Y) ((FACE-A-Y)

;; (display "case FACE-A-Y ")

(set! front-normal normal) (set! front-normal normal)
(set! front (+ (vec-dot pos-a front-normal) ha.y)) (set! front (+ (vec-dot pos-a front-normal) ha.y))
(set! side-normal rot-a.col-1) (set! side-normal rot-a.col-1)
Expand All @@ -158,14 +146,10 @@
(set! pos-side (+ side ha.x)) (set! pos-side (+ side ha.x))
(set! neg-edge EDGE2) (set! neg-edge EDGE2)
(set! pos-edge EDGE4) (set! pos-edge EDGE4)

(set! incident-edge
(compute-incident-edge (compute-incident-edge hb pos-b rot-b front-normal)))
incident-edge hb pos-b rot-b front-normal))


((FACE-B-X) ((FACE-B-X)

;; (display "case FACE-B-X ")

(set! front-normal (vec::neg normal)) (set! front-normal (vec::neg normal))
(set! front (+ (vec-dot pos-b front-normal) hb.x)) (set! front (+ (vec-dot pos-b front-normal) hb.x))
(set! side-normal rot-b.col-2) (set! side-normal rot-b.col-2)
Expand All @@ -174,13 +158,10 @@
(set! pos-side (+ side hb.y)) (set! pos-side (+ side hb.y))
(set! neg-edge EDGE3) (set! neg-edge EDGE3)
(set! pos-edge EDGE1) (set! pos-edge EDGE1)
(compute-incident-edge (set! incident-edge
incident-edge ha pos-a rot-a front-normal)) (compute-incident-edge ha pos-a rot-a front-normal)))


((FACE-B-Y) ((FACE-B-Y)

;; (display "case FACE-B-Y ")

(set! front-normal (vec::neg normal)) (set! front-normal (vec::neg normal))
(set! front (+ (vec-dot pos-b front-normal) hb.y)) (set! front (+ (vec-dot pos-b front-normal) hb.y))
(set! side-normal rot-b.col-1) (set! side-normal rot-b.col-1)
Expand All @@ -189,9 +170,8 @@
(set! pos-side (+ side hb.x)) (set! pos-side (+ side hb.x))
(set! neg-edge EDGE2) (set! neg-edge EDGE2)
(set! pos-edge EDGE4) (set! pos-edge EDGE4)
(compute-incident-edge (set! incident-edge
incident-edge ha pos-a rot-a front-normal)) (compute-incident-edge ha pos-a rot-a front-normal))))
)


(let ((clip-points-1 (vector (create-clip-vertex) (let ((clip-points-1 (vector (create-clip-vertex)
(create-clip-vertex))) (create-clip-vertex)))
Expand Down
104 changes: 20 additions & 84 deletions compute-incident-edge.sls
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -16,102 +16,38 @@


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (compute-incident-edge c h pos rot normal) (define (compute-incident-edge h pos rot normal)

(define i 0)

(is-vector c i)
(is-clip-vertex c.i)
(is-vec c.i.v)
(is-edges c.i.e)


(is-vec h) (is-vec h)


(is-mat rot) (let ((n (vec::neg (m*v (mat::transpose rot) normal))))

(let ((rot-t (rot.transpose)))

(let ((n (vec::neg (m*v rot-t normal))))

(let ((n-abs (vec::abs n)))

(is-vec n)
(is-vec n-abs)

(if (> n-abs.x n-abs.y)

(if (> (sign n.x) 0.0)

(begin

;; (say "********** BRANCH A B **********")

(set! i 0)

(c.i.v.set h.x (- h.y))
(c.i.e.in-edge-2! EDGE3)
(c.i.e.out-edge-2! EDGE4)

(set! i 1)

(c.i.v.set h.x h.y)
(c.i.e.in-edge-2! EDGE4)
(c.i.e.out-edge-2! EDGE1))

(begin

;; (say "********** BRANCH A C **********")

(set! i 0)

(c.i.v.set (- h.x) h.y)
(c.i.e.in-edge-2! EDGE1)
(c.i.e.out-edge-2! EDGE2)

(set! i 1)

(c.i.v.set (- h.x) (- h.y))
(c.i.e.in-edge-2! EDGE2)
(c.i.e.out-edge-2! EDGE3)

))

(if (> (sign n.y) 0.0)

(begin

;; (say "********** BRANCH D E **********")


(set! i 0) (let ((n-abs (vec::abs n)))

(is-vec n)
(is-vec n-abs)


(c.i.v.set h.x h.y) (define (make-incident-vertex x y in-edge-2 out-edge-2)
(c.i.e.in-edge-2! EDGE4) (make-clip-vertex (v+ pos (m*v rot (make-vec x y)))
(c.i.e.out-edge-2! EDGE1) (make-edges NO-EDGE NO-EDGE in-edge-2 out-edge-2)))


(set! i 1) (if (> n-abs.x n-abs.y)

(c.i.v.set (- h.x) h.y)
(c.i.e.in-edge-2! EDGE1)
(c.i.e.out-edge-2! EDGE2))


(begin (if (> (sign n.x) 0.0)


;; (say "********** BRANCH D F **********") (vector (make-incident-vertex h.x (- h.y) EDGE3 EDGE4)
(make-incident-vertex h.x h.y EDGE4 EDGE1))


(set! i 0) (vector (make-incident-vertex (- h.x) h.y EDGE1 EDGE2)
(make-incident-vertex (- h.x) (- h.y) EDGE2 EDGE3)))


(c.i.v.set (- h.x) (- h.y)) (if (> (sign n.y) 0.0)
(c.i.e.in-edge-2! EDGE2)
(c.i.e.out-edge-2! EDGE3)


(set! i 1) (vector (make-incident-vertex h.x h.y EDGE4 EDGE1)

(make-incident-vertex (- h.x) h.y EDGE1 EDGE2))
(c.i.v.set h.x (- h.y))
(c.i.e.in-edge-2! EDGE3)
(c.i.e.out-edge-2! EDGE4)))))))


(set! i 0) (c.i.v! (v+ pos (m*v rot c.i.v))) (vector (make-incident-vertex (- h.x) (- h.y) EDGE2 EDGE3)
(set! i 1) (c.i.v! (v+ pos (m*v rot c.i.v)))) (make-incident-vertex h.x (- h.y) EDGE3 EDGE4)))))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Expand Down

0 comments on commit bf870ef

Please sign in to comment.