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