extra/euler/b-rep/b-rep-tests.factor

   1 USING: accessors euler.b-rep euler.modeling euler.operators\r
   2 euler.b-rep.examples kernel locals math.vectors.simd.cords\r
   3 namespaces sequences tools.test ;\r
   4 IN: euler.b-rep.tests\r
   5 \r
   6 [ double-4{ 0.0 0.0 -1.0 0.0 } ]\r
   7 [ valid-cube-b-rep edges>> first face-normal ] unit-test\r
   8 \r
   9 [ double-4{ 0.0 0.0 -1.0 0.0 } -1.0 ]\r
  10 [ valid-cube-b-rep edges>> first face-plane ] unit-test\r
  11 \r
  12 [ t ] [ 0 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test\r
  13 [ t ] [ 5 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test\r
  14 [ f ] [ 6 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test\r
  15 \r
  16 :: mock-face ( p0 p1 p2 -- edge )\r
  17     b-edge new vertex new p0 >>position >>vertex :> e0\r
  18     b-edge new vertex new p1 >>position >>vertex :> e1\r
  19     b-edge new vertex new p2 >>position >>vertex :> e2\r
  20 \r
  21     e1 e0 next-edge<<\r
  22     e2 e1 next-edge<<\r
  23     e0 e2 next-edge<<\r
  24     \r
  25     e0 ;\r
  26 \r
  27 [\r
  28     double-4{\r
  29         0x1.279a74590331dp-1\r
  30         0x1.279a74590331dp-1\r
  31         0x1.279a74590331dp-1\r
  32         0.0\r
  33     }\r
  34     -0x1.bb67ae8584cabp1\r
  35 ] [\r
  36     double-4{ 1 0 5 0 }\r
  37     double-4{ 0 1 5 0 }\r
  38     double-4{ 0 0 6 0 } mock-face face-plane\r
  39 ] unit-test\r
  40 \r
  41 V{ t } clone sharpness-stack [\r
  42     [ t ] [ get-sharpness ] unit-test\r
  43     [ V{ f } ] [ f set-sharpness sharpness-stack get ] unit-test\r
  44     [ V{ f t } t ] [ t push-sharpness sharpness-stack get get-sharpness ] unit-test\r
  45     [ t V{ f } f ] [ pop-sharpness sharpness-stack get get-sharpness ] unit-test\r
  46 ] with-variable\r
  47 \r
  48 [ t ] [ valid-cube-b-rep [ edges>> first ] keep is-valid-edge? ] unit-test\r
  49 [ f ] [ b-edge new valid-cube-b-rep is-valid-edge? ] unit-test\r
  50 \r
  51 [ t ] [\r
  52     valid-cube-b-rep edges>>\r
  53     [ [  0 swap nth ] [  1 swap nth ] bi connecting-edge ]\r
  54     [    0 swap nth ] bi eq?\r
  55 ] unit-test\r
  56 \r
  57 [ t ] [\r
  58     valid-cube-b-rep edges>>\r
  59     [ [  1 swap nth ] [  0 swap nth ] bi connecting-edge ]\r
  60     [    6 swap nth ] bi eq?\r
  61 ] unit-test\r
  62 \r
  63 [ t ] [\r
  64     valid-cube-b-rep edges>>\r
  65     [ [  0 swap nth ] [  3 swap nth ] bi connecting-edge ]\r
  66     [   21 swap nth ] bi eq?\r
  67 ] unit-test\r
  68 \r
  69 [ f ] [\r
  70     valid-cube-b-rep edges>>\r
  71     [  0 swap nth ] [  2 swap nth ] bi connecting-edge\r
  72 ] unit-test\r
  73 \r
  74 [ double-4{ 0 0 -1 0 } ] [\r
  75     [\r
  76         { double-4{ 0 0 0 0 } double-4{ 0 1 0 0 } double-4{ 0 2 0 0 } double-4{ 1 1 0 0 } }\r
  77         smooth-smooth polygon>double-face face-normal\r
  78     ] make-b-rep drop\r
  79 ] unit-test\r