Splines: catmull-rom, bezier curve, cubic hermite, kochanek-bartels
Erik Charlebois
parent
c8192adf71
commit
941c09d73a
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax math ;
|
||||
IN: math.splines
|
||||
|
||||
HELP: <bezier-curve>
|
||||
{ $values
|
||||
{ "control-points" "sequence of control points same dimension" }
|
||||
{ "polynomials" "sequence of polynomials for each dimension" }
|
||||
}
|
||||
{ $description "Creates bezier curve polynomials for the given control points." } ;
|
||||
|
||||
HELP: <catmull-rom-spline>
|
||||
{ $values
|
||||
{ "points" "points on the spline" } { "m0" "initial tangent vector" } { "mn" "final tangent vector" }
|
||||
{ "polynomials-sequence" "sequence of sequences of polynomials" }
|
||||
}
|
||||
{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points and generating tangents for C1 continuity." } ;
|
||||
|
||||
HELP: <cubic-hermite-curve>
|
||||
{ $values
|
||||
{ "p0" "start point" } { "m0" "start tangent" } { "p1" "end point" } { "m1" "end tangent" }
|
||||
{ "polynomials" "sequence of polynomials" }
|
||||
}
|
||||
{ $description "Creates a sequence of polynomials (one per dimension) for the curve passing through " { $emphasis "p0" } " and " { $emphasis "p1" } "." } ;
|
||||
|
||||
HELP: <cubic-hermite-spline>
|
||||
{ $values
|
||||
{ "point-tangent-pairs" "sequence of point and tangent pairs" }
|
||||
{ "polynomials-sequence" "sequence of sequences of polynomials" }
|
||||
}
|
||||
{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points with the given tangents." } ;
|
||||
|
||||
HELP: <kochanek-bartels-curve>
|
||||
{ $values
|
||||
{ "points" "points on the spline" } { "m0" "start tangent" } { "mn" "end tangent" } { "tension" number } { "bias" number } { "continuity" number }
|
||||
{ "polynomials-sequence" "sequence of sequence of polynomials" }
|
||||
}
|
||||
{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points, generating tangents with the given tuning parameters." } ;
|
||||
|
||||
ARTICLE: "math.splines" "Common parametric curves."
|
||||
"The curve creating functions create sequences of polynomials, one for each degree of the input points. The spline creating functions create sequences of these curve polynomial sequences. The " { $vocab-link "math.splines.viewer" } " vocabulary provides a gadget to evaluate the generated polynomials and view the results.";
|
||||
|
||||
ABOUT: "math.splines"
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
! Copyright (C) 2010 Erik Charlebois
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators kernel locals math math.combinatorics
|
||||
math.polynomials opengl.gl sequences ui.gadgets ui.gadgets.panes
|
||||
ui.render arrays grouping math.vectors assocs
|
||||
ui.gestures ;
|
||||
IN: math.splines
|
||||
|
||||
<PRIVATE
|
||||
:: bernstein-polynomial-ith ( n i -- p )
|
||||
n i nCk { 0 1 } i p^ { 1 -1 } n i - p^ p* n*p ;
|
||||
|
||||
:: hermite-polynomial ( p0 m0 p1 m1 -- poly )
|
||||
p0
|
||||
m0
|
||||
-3 p0 * -2 m0 * + 3 p1 * + m1 neg +
|
||||
2 p0 * m0 + -2 p1 * + m1 +
|
||||
4array ;
|
||||
|
||||
:: kochanek-bartels-coefficients ( tension bias continuity -- s1 d1 s2 d2 )
|
||||
1 tension -
|
||||
[
|
||||
1 bias +
|
||||
[ 1 continuity + * * 2 / ]
|
||||
[ 1 continuity - * * 2 / ] 2bi
|
||||
]
|
||||
[
|
||||
1 bias -
|
||||
[ 1 continuity - * * 2 / ]
|
||||
[ 1 continuity + * * 2 / ] 2bi
|
||||
] bi ;
|
||||
|
||||
:: kochanek-bartels-tangents ( points m0 mn c1 c2 -- tangents )
|
||||
points 3 clump [
|
||||
first3 :> ( pi-1 pi pi+1 )
|
||||
pi pi-1 v- c1 v*n
|
||||
pi+1 pi v- c2 v*n v+
|
||||
] map
|
||||
m0 prefix
|
||||
mn suffix ;
|
||||
PRIVATE>
|
||||
|
||||
:: <bezier-curve> ( control-points -- polynomials )
|
||||
control-points
|
||||
[ length 1 - ]
|
||||
[ first length [ { 0 } ] replicate ]
|
||||
bi :> ( n acc )
|
||||
|
||||
control-points [| pt i |
|
||||
n i bernstein-polynomial-ith :> poly
|
||||
pt [| v j |
|
||||
j acc [ v poly n*p p+ ] change-nth
|
||||
] each-index
|
||||
] each-index
|
||||
acc ;
|
||||
|
||||
:: <cubic-hermite-curve> ( p0 m0 p1 m1 -- polynomials )
|
||||
p0 length iota [
|
||||
{
|
||||
[ p0 nth ] [ m0 nth ]
|
||||
[ p1 nth ] [ m1 nth ]
|
||||
} cleave
|
||||
hermite-polynomial
|
||||
] map ;
|
||||
|
||||
<PRIVATE
|
||||
: (cubic-hermite-spline) ( point-in-out-triplets -- polynomials-sequence )
|
||||
2 clump [
|
||||
first2 [ first2 ] [ [ first ] [ third ] bi ] bi* <cubic-hermite-curve>
|
||||
] map ;
|
||||
PRIVATE>
|
||||
|
||||
: <cubic-hermite-spline> ( point-tangent-pairs -- polynomials-sequence )
|
||||
2 clump [ first2 [ first2 ] bi@ <cubic-hermite-curve> ] map ;
|
||||
|
||||
:: <kochanek-bartels-curve> ( points m0 mn tension bias continuity -- polynomials-sequence )
|
||||
tension bias continuity kochanek-bartels-coefficients :> ( s1 d1 s2 d2 )
|
||||
points m0 mn
|
||||
[ s1 s2 kochanek-bartels-tangents ]
|
||||
[ d1 d2 kochanek-bartels-tangents ] 3bi :> ( in out )
|
||||
points in out [ 3array ] 3map (cubic-hermite-spline) ;
|
||||
|
||||
: <catmull-rom-spline> ( points m0 mn -- polynomials-sequence )
|
||||
0 0 0 <kochanek-bartels-curve> ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Common parametric curves
|
||||
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: locals math.splines math.splines.viewer arrays ;
|
||||
IN: math.splines.testing
|
||||
|
||||
: test1 ( -- )
|
||||
{
|
||||
{ { 0 0 } { 0 200 } }
|
||||
{ { 100 50 } { 0 -200 } }
|
||||
{ { 300 300 } { 500 200 } }
|
||||
{ { 400 400 } { 300 0 } }
|
||||
} <cubic-hermite-spline> { 50 100 } 4 spline. ;
|
||||
|
||||
: test2 ( -- )
|
||||
{
|
||||
{ 50 50 }
|
||||
{ 100 100 }
|
||||
{ 300 200 }
|
||||
{ 350 0 }
|
||||
{ 400 400 }
|
||||
} { 0 100 } { 100 0 } <catmull-rom-spline> { 100 50 } 50 spline. ;
|
||||
|
||||
:: test3 ( x y z -- )
|
||||
{
|
||||
{ 100 50 }
|
||||
{ 200 350 }
|
||||
{ 300 50 }
|
||||
} { 0 100 } { 0 -100 } x y z <kochanek-bartels-curve> { 50 50 } 1000 spline. ;
|
||||
|
||||
: test4 ( -- )
|
||||
{
|
||||
{ 0 5 }
|
||||
{ 0.5 3 }
|
||||
{ 10 10 }
|
||||
{ 12 4 }
|
||||
{ 15 5 }
|
||||
} <bezier-curve> 1array { 100 100 } 100 spline. ;
|
||||
|
||||
: test-splines ( -- )
|
||||
test1 test2
|
||||
1 0 0 test3
|
||||
-1 0 0 test3
|
||||
0 1 0 test3
|
||||
0 -1 0 test3
|
||||
0 0 1 test3
|
||||
0 0 -1 test3
|
||||
test4 ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel locals math math.order math.polynomials
|
||||
math.splines opengl.gl sequences ui.gadgets ui.gadgets.panes ui.render
|
||||
arrays ;
|
||||
IN: math.splines.viewer
|
||||
|
||||
<PRIVATE
|
||||
: eval-polynomials ( polynomials-seq n -- xy-sequence )
|
||||
[
|
||||
[ 1 + iota ] keep [
|
||||
/f swap [ polyval ] with map
|
||||
] curry with map
|
||||
] curry map concat ;
|
||||
PRIVATE>
|
||||
|
||||
TUPLE: spline-gadget < gadget polynomials steps spline-dim ;
|
||||
|
||||
M: spline-gadget pref-dim* spline-dim>> ;
|
||||
|
||||
M:: spline-gadget draw-gadget* ( gadget -- )
|
||||
0 0 0 glColor3f
|
||||
|
||||
gadget [ polynomials>> ] [ steps>> ] bi eval-polynomials :> pts
|
||||
|
||||
pts [ first ] [ max ] map-reduce :> x-max
|
||||
pts [ first ] [ min ] map-reduce :> x-min
|
||||
pts [ second ] [ max ] map-reduce :> y-max
|
||||
pts [ second ] [ min ] map-reduce :> y-min
|
||||
|
||||
pts [
|
||||
[ first x-min - x-max x-min - / gadget spline-dim>> first * ]
|
||||
[ second y-min - y-max y-min - / gadget spline-dim>> second * ] bi 2array
|
||||
] map :> pts
|
||||
|
||||
GL_LINE_STRIP glBegin
|
||||
pts [
|
||||
first2 neg gadget spline-dim>> second + glVertex2f
|
||||
] each
|
||||
glEnd ;
|
||||
|
||||
:: <spline-gadget> ( polynomials dim steps -- gadget )
|
||||
spline-gadget new
|
||||
dim >>spline-dim
|
||||
polynomials >>polynomials
|
||||
steps >>steps ;
|
||||
|
||||
: spline. ( curve dim steps -- )
|
||||
<spline-gadget> gadget. ;
|
||||
Loading…
Reference in New Issue