extra/euler/modeling/modeling-tests.factor

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