Commit 6a20b603 authored by Dave Cooper's avatar Dave Cooper

trying to get centripetal cardinal-spline working, still don't have correct...

trying to get centripetal cardinal-spline working, still don't have correct implementation on the SMLib side of things.
parent fc3663dc
This diff is collapsed.
......@@ -114,8 +114,6 @@ If any of the weights are different from 1.0, it is Rational."
:input-slots
("List of 3D Points. The control points."
control-points
......
......@@ -25,14 +25,24 @@
(define-object cardinal-spline (curve)
:documentation (:description
"This object makes a Cardinal Spline, which defaults to a Catmull-Rom Spline for nil tension-params (which means they all default to 0.0)"
"This object makes a Cardinal Spline, which defaults
to a Catmull-Rom Spline for nil tension-params (which means they all
default to 0.0)."
:author "Dave Cooper, Genworks International")
:input-slots (through-points
(tension-params nil)
(periodic? nil)
(alpha 0))
("Keyword symbol. <tt>uniform</tt> gives alpha 0, <tt>centripetal</tt> gives alpha 0.5,
<tt>:chordal</tt> gives alpha 1. Default is nil, which lets alpha defer to its default, which is 0 (uniform)."
parameterization nil)
("Alpha value to control parameterization.
See <tt>parameterization</tt> input-slot for keyword equivalents.
Default is 0" alpha (if (the parameterization)
(ecase (the parameterization)
(:uniform 0)(:centripetal 0.5)(:chordal 1)) 0)))
:computed-slots ((native-curve-iw (make-cardinal-spline *geometry-kernel*
:periodic? (the periodic?)
:tension-params (the tension-params)
......@@ -45,44 +55,149 @@
:alpha (the alpha)))))
(define-object display-pts ()
:objects
((through :type (if (typep self 'cardinal-spline) 'points-display 'null-object)
:points (when (typep self 'cardinal-spline) (the through-points))
:display-controls (list :color :green))
(control :type 'points-display
:points (the control-points)
:display-controls (list :color :red))))
(define-object cardinal-spline* (cardinal-spline display-pts))
(define-object test-uniform-cr (cardinal-spline)
(define-object test-uniform-cr (cardinal-spline*)
:computed-slots
((through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(define-object test-centripetal-cr (cardinal-spline)
(define-object test-centripetal-cr (cardinal-spline*)
:computed-slots
((alpha 0.5)
(through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(define-object test-chordal-cr (cardinal-spline)
(define-object test-chordal-cr (cardinal-spline*)
:computed-slots
((alpha 1)
(through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(define-object tom (base-object)
:objects
((uniform :type 'tom-cr :parameterization :uniform)
(centripetal :type 'tom-cr :parameterization :centripetal)
(chordal :type 'tom-cr :parameterization :chordal)
(alpha :type 'tom-cr :alpha 0.9)
(frank :type 'b-spline-curve*
:control-points (the uniform control-points)
:knot-vector (the centripetal knot-vector)
#+nil
(normalize :knot-vector (the centripetal knot-vector)
:u-min (the uniform u-min)
:u-max (the uniform u-max)))
(stein :type 'b-spline-curve*
:control-points (the centripetal control-points)
:knot-vector (the uniform knot-vector))
(frank-chordal :type 'b-spline-curve*
:control-points (the uniform control-points)
:knot-vector (the chordal knot-vector))
))
(define-object b-spline-curve* (b-spline-curve display-pts))
(define-object tom-cr (cardinal-spline*)
:computed-slots
((periodic? t)
(through-points
#+nil
(list (make-point 0 0 0) (make-point 1 1 0)
(make-point 1.1 1 0) (make-point 2 0 0))
'(#(0.0 -91.0 6.5) #(96.0 -82.0 6.5) #(100.0 -68.5 6.5)
#(96.0 -54.99999999999999 6.5) #(0.0 -46.0 6.5)
#(-96.0 -54.99999999999999 6.5) #(-100.0 -68.5 6.5) #(-96.0 -82.0 6.5)))))
(define-object test-b-spline-curves (base-object)
:input-slots
((control-points (list (make-point 0 0 0)
(make-point 2 3.0 0.0)
(make-point 4 2.0 0.0)
(make-point 5 0.0 0.0)
(make-point 4 -2.0 0.0)
(make-point 2 -3.0 0.0)
(make-point 0 0 0))))
:hidden-objects
((view :type 'base-view
:page-length (* 5 72) :page-width (* 5 72)
:pseudo-inputs (page-length page-width)
:objects (the children)))
:objects
((note :type 'general-note
:strings "Hey Now")
(curve :type 'b-spline-curve
:control-points (the control-points)
:degree 3
:display-controls (list :line-thickness 1
:color :orange))
(kcurve :type 'b-spline-curve
:control-points (the control-points)
:knot-vector '(0.0 0.0 0.0 0.0 1/8 1/2 6/8 1.0 1.0 1.0 1.0)
:degree 3
:display-controls (list :line-thickness 1
:color :red))
(points :type 'point
:sequence (:size (length (rest (the control-points))))
:center (nth (the-child index) (rest (the control-points)))
:display-controls (list :color :green))))
(defun normalize (&key knot-vector u-min u-max)
(let* ((new-delta (- (apply #'max knot-vector) (apply #'min knot-vector)))
(old-delta (- u-max u-min))
(step-ratio (div old-delta new-delta)))
(mapcar #'(lambda(knot) (* knot step-ratio)) knot-vector)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment