extra/nurbs/nurbs-tests.factor

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