nurbs: cleanup.
parent
33f2fbd099
commit
3f2404a628
|
@ -1,9 +1,9 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alien.c-types arrays grouping kernel locals
|
||||
math math.order math.ranges math.vectors
|
||||
math.vectors.homogeneous sequences specialized-arrays ;
|
||||
FROM: alien.c-types => float ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
! Copyright (C) 2009 Joe Groff
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
USING: accessors alien.c-types grouping kernel locals math
|
||||
math.order math.ranges math.vectors math.vectors.homogeneous
|
||||
sequences specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: alien.c-types:float
|
||||
IN: nurbs
|
||||
|
||||
TUPLE: nurbs-curve
|
||||
|
@ -55,10 +55,10 @@ TUPLE: nurbs-curve
|
|||
knot-constants second t * knot-constants fourth + bases second *
|
||||
+ ;
|
||||
|
||||
: (eval-curve) ( base-values control-points -- value )
|
||||
: eval-curve ( base-values control-points -- value )
|
||||
[ n*v ] 2map { 0.0 0.0 0.0 } [ v+ ] binary-reduce h>v ;
|
||||
|
||||
:: (eval-bases) ( curve t interval values order -- values' )
|
||||
:: eval-bases ( curve t interval values order -- values' )
|
||||
order 2 - curve (knot-constants)>> nth :> all-knot-constants
|
||||
interval order interval + all-knot-constants clip-range :> ( from to )
|
||||
from to all-knot-constants subseq :> knot-constants
|
||||
|
@ -66,8 +66,8 @@ TUPLE: nurbs-curve
|
|||
|
||||
knot-constants bases [ t eval-base ] 2map :> values'
|
||||
order curve order>> =
|
||||
[ values' from to curve control-points>> subseq (eval-curve) ]
|
||||
[ curve t interval 1 - values' order 1 + (eval-bases) ] if ;
|
||||
[ values' from to curve control-points>> subseq eval-curve ]
|
||||
[ curve t interval 1 - values' order 1 + eval-bases ] if ;
|
||||
|
||||
: eval-nurbs ( nurbs-curve t -- value )
|
||||
2dup knot-interval 1 - { 1.0 } 2 (eval-bases) ;
|
||||
2dup knot-interval 1 - { 1.0 } 2 eval-bases ;
|
||||
|
|
Loading…
Reference in New Issue