extra/euler/modeling/modeling-tests.factor

   1 USING: accessors kernel tools.test euler.b-rep euler.operators
   2 euler.modeling game.models.half-edge ;
   3 IN: euler.modeling.tests
   4
   5 ! polygon>double-face
   6 { } [
   7     [
   8         { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } { -1 1 0 } }
   9         smooth-smooth polygon>double-face
  10         [ face-sides 4 assert= ]
  11         [ opposite-edge>> face-sides 4 assert= ]
  12         [ face-normal { 0.0 0.0 1.0 } assert= ]
  13         tri
  14     ] make-b-rep check-b-rep
  15 ] unit-test
  16
  17 ! extrude-simple
  18 { } [
  19     [
  20         { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } }
  21         smooth-smooth polygon>double-face
  22         1 f extrude-simple
  23         [ face-sides 3 assert= ]
  24         [ opposite-edge>> face-sides 4 assert= ]
  25         bi
  26     ] make-b-rep check-b-rep
  27 ] unit-test
  28
  29 ! project-pt-line
  30 { {  0 1 0 } } [ {  0 0 0 } { 0 1 0 } { 1 1 0 } project-pt-line ] unit-test
  31 { {  0 1 0 } } [ {  0 0 0 } { 1 1 0 } { 0 1 0 } project-pt-line ] unit-test
  32 { {  0 1 0 } } [ {  0 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
  33 { { -1 1 0 } } [ { -1 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
  34 { { 1/2 1/2 0 } } [ {  0 0 0 } { 0 1 0 } { 1 0 0 } project-pt-line ] unit-test
  35
  36 ! project-pt-plane
  37 { {  0  0  1 } } [ { 0 0 0 } { 0 0 1 } { 0 0  1 } -1 project-pt-plane ] unit-test
  38 { {  0  0 -1 } } [ { 0 0 0 } { 0 0 1 } { 0 0  1 }  1 project-pt-plane ] unit-test
  39 { {  0  0  3 } } [ { 0 0 0 } { 0 0 1 } { 0 0  1 } -3 project-pt-plane ] unit-test
  40 { {  0  0  3 } } [ { 0 0 0 } { 0 0 1 } { 0 0 -1 }  3 project-pt-plane ] unit-test
  41 { {  0  0  1 } } [ { 0 0 0 } { 0 0 1 } { 0 1  1 } -1 project-pt-plane ] unit-test
  42
  43 { { 0 2/3 1/3 } } [ { 0 0 0 } { 0 2 1 } { 0 1  1 } -1 project-pt-plane ] unit-test
  44
  45 { {  0  0  1 } } [ { 0 0 0 } { 0 0   1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test
  46 { {  0  1  1 } } [ { 0 0 0 } { 0 1/2 1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test