normally-projected-curve.lisp 2.05 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
(in-package :surf)

(define-object normally-projected-curve (curve)

  :input-slots (from-surface
		curve to-surface
		(number-of-points 200))


  :computed-slots ((sample-points (the curve uv-curve (equi-spaced-points (the number-of-points))))

		   (normals (mapcar #'(lambda(point) (the from-surface (normal (get-u point) (get-v point)))) (the sample-points)))

		   (projected-points (mapcar #'(lambda(point normal)
						 (the to-surface (projected-point (the from-surface (point (get-u point) (get-v point))) normal)))
					     (the sample-points) (the normals)))

		   (projected-points-3d (mapcar #'get-3d-point-of (the projected-points)))


		   (projected-points-uv (mapcar #'get-uv-point-of (the projected-points))))

  
  
  :objects ((fitted :type 'fitted-curve
		    :points (the projected-points-3d))

	    (fitted-uv :type 'fitted-curve
		       :points (mapcar #'(lambda(point) (make-point (get-x point) (get-y point) 0)) (the projected-points-uv)))

	    (approximated :type 'approximated-curve
			  :curve-in (the fitted-uv)
			  :tolerance 0.00001)
	    
	    (fitted-3d :type 'b-spline-curve
		       :knot-vector (the approximated knot-vector)
		       :degree (the approximated degree)
		       :weights (the approximated weights)
		       :control-points (mapcar #'(lambda(point)
						   (the to-surface (point (get-u point) (get-v point))))
					       (the approximated control-points)))))
  


#+nil
(define-object normally-projected-curve-test (normally-projected-curve)

  :computed-slots ((from-surface (the test-fitted-surface))
		   (curve (the projected))
		   (to-surface (the offset-surface)))


  :objects ((test-fitted-surface :type 'test-fitted-surface
				 :grid-height 1)

	    (offset-surface :type 'rectangular-surface
			    :length 5 :width 5 :center (make-point 2 2 1.5))

	    (projected :type 'projected-curve
		       :curve-in (the segment)
		       :surface (the test-fitted-surface)
		       :projection-vector (the (face-normal-vector :bottom)))

	    (segment :type 'linear-curve
		     :start (make-point 1 1 3)
		     :end (make-point 3 3 3))))