1 USING: accessors arrays assocs euler.b-rep
2 game.models.half-edge kernel locals math math.vectors
3 math.vectors.simd.cords sequences sets typed fry ;
4 FROM: sequences.private => nth-unsafe set-nth-unsafe ;
5 IN: euler.b-rep.subdivision
7 : <vertex> ( position -- vertex ) vertex new swap >>position ; inline
9 : face-points ( faces -- face-pts )
10 [ edge>> face-midpoint <vertex> ] map ; inline
12 :: edge-points ( edges edge-indices face-indices face-points -- edge-pts )
13 edges length 0 <array> :> edge-pts
16 edge opposite-edge>> :> opposite-edge
17 opposite-edge edge-indices at :> opposite-n
20 edge vertex>> position>>
21 opposite-edge vertex>> position>> v+
22 edge face>> face-indices at face-points nth position>> v+
23 opposite-edge face>> face-indices at face-points nth position>> v+
26 [ n edge-pts set-nth-unsafe ]
27 [ opposite-n edge-pts set-nth-unsafe ] bi
33 :: vertex-points ( vertices edge-indices face-indices edge-pts face-points -- vertex-pts )
35 0 double-4{ 0 0 0 0 } double-4{ 0 0 0 0 }
36 vertex edge>> [| valence face-sum edge-sum edge |
38 face-sum edge face>> face-indices at face-points nth position>> v+
39 edge-sum edge next-edge>> vertex>> position>> v+
40 ] each-vertex-edge :> ( valence face-sum edge-sum )
41 valence >float :> fvalence
42 face-sum fvalence v/n :> face-avg
43 edge-sum fvalence v/n :> edge-avg
44 face-avg edge-avg v+ vertex position>> fvalence 2.0 - v*n v+
49 TYPED:: subdivide ( brep: b-rep -- brep': b-rep )
50 brep vertices>> :> vertices
54 vertices >index-hash :> vertex-indices
55 edges >index-hash :> edge-indices
56 faces >index-hash :> face-indices
58 faces face-points :> face-pts
59 edges edge-indices face-indices face-pts edge-points :> edge-pts
60 vertices edge-indices face-indices edge-pts face-pts vertex-points :> vertex-pts
62 V{ } clone :> sub-edges
63 V{ } clone :> sub-faces
67 edg edge-indices at edge-pts nth :> point-a
68 edg next-edge>> :> next-edg
69 next-edg vertex>> :> next-vertex
70 next-vertex vertex-indices at vertex-pts nth :> point-b
71 next-edg edge-indices at edge-pts nth :> point-c
72 edg face>> face-indices at face-pts nth :> point-d
75 dup >>base-face :> fac
79 point-a >>vertex :> edg-a
82 point-b >>vertex :> edg-b
85 point-c >>vertex :> edg-c
88 point-d >>vertex :> edg-d
90 edg-b edg-a next-edge<<
91 edg-c edg-b next-edge<<
92 edg-d edg-c next-edge<<
93 edg-a edg-d next-edge<<
101 point-a [ edg-a or ] change-edge drop
102 point-b [ edg-b or ] change-edge drop
103 point-c [ edg-c or ] change-edge drop
104 point-d [ edg-d or ] change-edge drop
109 sub-faces { } like >>faces
110 sub-edges { } like >>edges
111 face-pts edge-pts vertex-pts 3append members { } like >>vertices
112 [ connect-opposite-edges ] keep ;