steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

nurbs: cleanup.

char-rename
John Benediktsson 2017-01-22 14:47:50 -08:00
parent 33f2fbd099
commit 3f2404a628
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/nurbs/nurbs.factor
View File

@ -1,9 +1,9 @@
! (c)2009 Joe Groff bsd license ! Copyright (C) 2009 Joe Groff
USING: accessors alien.c-types arrays grouping kernel locals ! See http://factorcode.org/license.txt for BSD license
math math.order math.ranges math.vectors USING: accessors alien.c-types grouping kernel locals math
math.vectors.homogeneous sequences specialized-arrays ; math.order math.ranges math.vectors math.vectors.homogeneous
FROM: alien.c-types => float ; sequences specialized-arrays ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: alien.c-types:float
IN: nurbs IN: nurbs
TUPLE: nurbs-curve TUPLE: nurbs-curve
@ -55,10 +55,10 @@ TUPLE: nurbs-curve
knot-constants second t * knot-constants fourth + bases second * 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 ; [ 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 order 2 - curve (knot-constants)>> nth :> all-knot-constants
interval order interval + all-knot-constants clip-range :> ( from to ) interval order interval + all-knot-constants clip-range :> ( from to )
from to all-knot-constants subseq :> knot-constants from to all-knot-constants subseq :> knot-constants
@ -66,8 +66,8 @@ TUPLE: nurbs-curve
knot-constants bases [ t eval-base ] 2map :> values' knot-constants bases [ t eval-base ] 2map :> values'
order curve order>> = order curve order>> =
[ values' from to curve control-points>> subseq (eval-curve) ] [ values' from to curve control-points>> subseq eval-curve ]
[ curve t interval 1 - values' order 1 + (eval-bases) ] if ; [ curve t interval 1 - values' order 1 + eval-bases ] if ;
: eval-nurbs ( nurbs-curve t -- value ) : eval-nurbs ( nurbs-curve t -- value )
2dup knot-interval 1 - { 1.0 } 2 (eval-bases) ; 2dup knot-interval 1 - { 1.0 } 2 eval-bases ;