extra/nurbs/nurbs-tests.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: literals math math.functions math.vectors namespaces
   3 nurbs tools.test ;
   4 IN: nurbs.tests
   5
   6 SYMBOL: test-nurbs
   7
   8 CONSTANT:  √2/2 $[ 0.5 sqrt     ]
   9 CONSTANT: -√2/2 $[ 0.5 sqrt neg ]
  10
  11 ! unit circle as NURBS
  12 3 {
  13     { 1.0 0.0 1.0 }
  14     ${ √2/2 √2/2 √2/2 }
  15     { 0.0 1.0 1.0 }
  16     ${ -√2/2 √2/2 √2/2 }
  17     { -1.0 0.0 1.0 }
  18     ${ -√2/2 -√2/2 √2/2 }
  19     { 0.0 -1.0 1.0 }
  20     ${ √2/2 -√2/2 √2/2 }
  21     { 1.0 0.0 1.0 }
  22 } { 0.0 0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75 1.0 1.0 1.0 } <nurbs-curve> test-nurbs set
  23
  24 { t } [ test-nurbs get 0.0   eval-nurbs {   1.0   0.0 } 0.00001 v~ ] unit-test
  25 { t } [ test-nurbs get 0.25  eval-nurbs {   0.0   1.0 } 0.00001 v~ ] unit-test
  26 { t } [ test-nurbs get 0.5   eval-nurbs {  -1.0   0.0 } 0.00001 v~ ] unit-test
  27 { t } [ test-nurbs get 0.75  eval-nurbs {   0.0  -1.0 } 0.00001 v~ ] unit-test
  28
  29 { t } [ test-nurbs get 0.125 eval-nurbs ${ √2/2 √2/2 } 0.00001 v~ ] unit-test
  30 { t } [ test-nurbs get 0.375 eval-nurbs ${ -√2/2 √2/2 } 0.00001 v~ ] unit-test
  31 { t } [ test-nurbs get 0.625 eval-nurbs ${ -√2/2 -√2/2 } 0.00001 v~ ] unit-test
  32 { t } [ test-nurbs get 0.875 eval-nurbs ${ √2/2 -√2/2 } 0.00001 v~ ] unit-test