subdivide ( brep: b-rep -- brep': b-rep )

Vocabulary

euler.b-rep.subdivision

Inputs

brep

a b-rep

Outputs

brep'

a b-rep

Definition

USING: accessors assocs euler.b-rep game.models.half-edge kernel
sequences sets typed ;

IN: euler.b-rep.subdivision

TYPED:: subdivide ( brep: b-rep -- brep': b-rep )
    brep vertices>> :> vertices brep edges>> :> edges brep
    faces>> :> faces vertices >index-hash :> vertex-indices
    edges >index-hash :> edge-indices faces >index-hash
    :> face-indices faces face-points :> face-pts edges
    edge-indices face-indices face-pts edge-points
    :> edge-pts vertices edge-indices face-indices edge-pts
    face-pts vertex-points :> vertex-pts V{ } clone :> sub-edges
    V{ } clone :> sub-faces vertices [
        edge>> [| edg |
            edg edge-indices at edge-pts nth
            :> point-a edg next-edge>> :> next-edg next-edg
            vertex>> :> next-vertex next-vertex vertex-indices
            at vertex-pts nth
            :> point-b next-edg edge-indices at edge-pts nth
            :> point-c edg face>> face-indices at face-pts nth
            :> point-d face new dup >>base-face
            :> fac b-edge new fac >>face point-a >>vertex
            :> edg-a b-edge new fac >>face point-b >>vertex
            :> edg-b b-edge new fac >>face point-c >>vertex
            :> edg-c b-edge new fac >>face point-d >>vertex
            :> edg-d edg-a fac edge<< edg-b edg-a next-edge<<
            edg-c edg-b next-edge<< edg-d edg-c next-edge<<
            edg-a edg-d next-edge<< fac sub-faces push
            edg-a sub-edges push edg-b sub-edges push
            edg-c sub-edges push edg-d sub-edges push point-a
            [ edg-a or ] change-edge drop point-b ~11 more~
        ] each-vertex-edge
    ] each b-rep new sub-faces { } like >>faces sub-edges
    { } like >>edges face-pts edge-pts vertex-pts 3append
    members { } like >>vertices [ connect-opposite-edges ] keep
    ;